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

[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

Φιλικά

Τάσος

[Free_Ghost]

Καλά στην αρχή που είδα αυτό το κατεβατό τρόμαξα και δεν έβγαζα (βγάζω) τίποτα....

Τελικά όμως πέταξα το προηγούμενο κώδικα που είχα βάλει στην Λειτουργική μονάδα και έβαλα αυτόν, στη συνέχεια άλλαξα και τον κώδικα του πλήκτρου και δούλεψε κατευθείαν χωρίς κανένα πρόβλημα...

Από ότι κατάλαβα με αυτήν την μέθοδο μπορείς να βάλεις και τρίτη διαδρομή και πάνω....

Εγώ πάντως με τον τρόπο που προσπαθούσα (και χωρίς όλα αυτά στην Λειτουργική μονάδα) δεν θα το κατάφερνα ποτέ, απέχω πάρα πολύ...

Δεν ξέρω εάν μπορούμε να πετύχουμε και κάποια ένδειξη για το αν υπάρχει η όχι αρχείο, αλλά δεν με ενοχλεί ιδιαίτερα διότι είναι δευτερεύων...

Τώρα τη να ξαναπώ πλέον Τάσο, δεν ξέρω πια πώς να σε Ευχαριστήσω εσένα και τα παιδιά του forum..