[Tasos]

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

'Πηγή: 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

Φιλικά

Τάσος