Forum - Άνοιγμα συγκεκριμένου αρχείου Pdf

Χρήστο, βάλε τον παρακάτω κώδικα σε μια λειτουργική μονάδα (αντικατέστησε τον προηγούμενο αν χρειαστεί):

Κώδικας:


 'Πηγή: Microsoft (με κάποιες τροποποιήσεις)
 

Option Compare Database

Option Explicit
 

Public Enum SWConstants

    SW_HIDE = 0

    SW_MAXIMIZE = 3

    SW_MINIMIZE = 6

    SW_SHOWMAXIMIZED = 3

    SW_SHOWMINIMIZED = 2

    SW_SHOWNORMAL = 1

    SW_SHOWNOACTIVATE = 4

    SW_SHOWNA = 8

    SW_SHOWMINNOACTIVE = 7

    SW_SHOWDEFAULT = 10

    SW_RESTORE = 9

    SW_SHOW = 5

End Enum
 

Private Declare Function ShellExecute _

                          Lib "shell32.dll" Alias _

                              "ShellExecuteA" ( _

                              ByVal hwnd As Long, ByVal lpOperation As String, _

                              ByVal lpFile As String, ByVal lpParameters As String, _

                              ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 

Private Const ERROR_FILE_NOT_FOUND = 2&

Private Const ERROR_PATH_NOT_FOUND = 3&

Private Const ERROR_BAD_FORMAT = 11&

Private Const SE_ERR_ACCESSDENIED = 5&

Private Const SE_ERR_ASSOCINCOMPLETE = 27&

Private Const SE_ERR_DDEBUSY = 30&

Private Const SE_ERR_DDEFAIL = 29&

Private Const SE_ERR_DDETIMEOUT = 28&

Private Const SE_ERR_DLLNOTFOUND = 32&

Private Const SE_ERR_FNF = 2&

Private Const SE_ERR_NOASSOC = 31&

Private Const SE_ERR_PNF = 3&

Private Const SE_ERR_OOM = 8&

Private Const SE_ERR_SHARE = 26&
 
 

Public Function ShellExec( _

       ByVal sFile As String, _

       Optional ByVal eShowCmd As SWConstants = SW_SHOWDEFAULT, _

       Optional ByVal sParameters As String = "", _

       Optional ByVal sDefaultDir As String = "", _

       Optional sOperation As String = "open", _

       Optional Owner As Long = 0 _

       ) As Integer

    Dim result As Long

    Dim lngError As Long

    Dim sError As String

    

    If Right(UCase(sFile), 4) = ".EXE" Then eShowCmd = 0

    

    On Error Resume Next

        result = ShellExecute(Owner, sOperation, sFile, sParameters, sDefaultDir, eShowCmd)

    If result < 0 Or result > 32 Then

        ShellExec = True

    Else

        lngError = 1048 + result + vbObjectError
 

        Select Case result

            Case 0

                lngError = 7: sError = "Δεν υπάρχει διαθέσιμη μνήμη."

            Case ERROR_FILE_NOT_FOUND

                lngError = 53

                sError = "Το αρχείο δεν βρέθηκε."

            Case ERROR_PATH_NOT_FOUND

                lngError = 76

                sError = "Η διαδρομή δεν βρέθηκε."

            Case ERROR_BAD_FORMAT

                lngError = 11

                sError = "Το εκτελέσιμο αρχείο δεν είναι έγκυρο ή είναι κατεστραμμένο."

            Case SE_ERR_ACCESSDENIED

                lngError = 75

                sError = "Σφάλμα πρόσβασης στη διαδρομή ή στο αρχείο."

            Case SE_ERR_ASSOCINCOMPLETE

                lngError = 27

                sError = "Αυτός ο τύπος αρχείου δεν έχει έγκυρη συσχέτιση αρχείου."

            Case SE_ERR_DDEBUSY

                lngError = 285

                sError = "Το αρχείο δεν θα μπορούσε να ανοίξει, διότι η εφαρμογή είναι απασχολημένη. Παρακαλώ δοκιμάστε ξανά σε λίγο."

            Case SE_ERR_DDEFAIL

                lngError = 285

                sError = "Το αρχείο δεν μπορεί να ανοίξει, διότι η συναλλαγή DDE απέτυχε. Παρακαλώ δοκιμάστε ξανά σε λίγο."

            Case SE_ERR_DDETIMEOUT

                lngError = 286

                sError = "Το αρχείο δεν μπορεί να ανοίξει, διότι η συναλλαγή DDE απέτυχε. Παρακαλώ δοκιμάστε ξανά σε λίγο."

            Case SE_ERR_DLLNOTFOUND

                lngError = 48

                sError = "Η συγκεκριμένη βιβλιοθήκη δυναμικής σύνδεσης δεν βρέθηκε."

            Case SE_ERR_FNF

                lngError = 53

                sError = "Το αρχείο δεν βρέθηκε."

            Case SE_ERR_NOASSOC

                sError = "Καμία εφαρμογή δεν σχετίζεται με αυτόν τον τύπο αρχείου."

            Case SE_ERR_OOM

                lngError = 7

                sError = "Δεν υπάρχει διαθέσιμη μνήμη."

            Case SE_ERR_PNF

                lngError = 76

                sError = "Η διαδρομή δεν βρέθηκε."

            Case SE_ERR_SHARE

                lngError = 75

                sError = "Σφάλμα πρόσβασης στη διαδρομή ή στο αρχείο."

            Case Else

                sError = "Προκλήθηκε σφάλμα κατά το άνοιγμα ή την εκτύπωση του επιλεγμένου αρχείου."

        End Select
 

        Err.Raise lngError, , sError
 

    End If

End Function

Κατόπιν μετονόμασε το κουμπί της φόρμας "Εντολή152" σε "CmdOpenPdf" και πέρασε του τον παρακάτω κώδικα και δοκίμασε:

Κώδικας:

Private Sub CmdOpenPdf_Click()

    Dim ret As Integer, pdfPath As String
 

    If Not IsNull(Me.Protokollo) Then

        ' Προσάρμοσε τη διαδρομή φακέλου του αρχείου.

        pdfPath = "D:\files\" & Me.Protokollo & ".pdf"
 

        If Dir(pdfPath, vbDirectory) = vbNullString Then

            'εναλλακτική διαδρομή φακέλου.

            pdfPath = "E:\files\" & Me.Protokollo & ".pdf"

        End If
 

        ' Άνοιγμα φακέλου και επιλογή ενός αρχείου

        ' ret = ShellExec("explorer", SW_SHOWNORMAL, "/select, pdfPath)
 

        ' Εκτέλεση ενός αρχείου

        ret = ShellExec(pdfPath)
 

        If Not ret Then

            Beep

            MsgBox "Σφάλμα: " & Err & vbLf & Err.Description, , "Ms-Office.gr"

        End If

    Else

        MsgBox "Το πεδίο είναι κενό"

    End If

End Sub

Φιλικά

Τάσος