Εμφάνιση ενός μόνο μηνύματος
  #1  
Παλιά 03-05-17, 16:38
ΤΙΜΟΣ Ο χρήστης ΤΙΜΟΣ δεν είναι συνδεδεμένος
Όνομα: Τίμος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 13-03-2015
Μηνύματα: 44
Προεπιλογή Εξαγωγή αρχείου σε μορφή pdf με επιλογή θέσης και με alarm ύπαρξης ίδιου ονόματος

Χρόνια Πολλά σ' όλους
Χριστός Ανέστη.
Για άλλη μία φορά θα χρειαστώ την βοήθεια από τα μέλη του φόρουμ. Παραθέτω δύο κώδικες, τους οποίους μου τους έστειλε ο Γιώργος (kapetang) σε παλαιότερα θέματα που είχα ζητήσει βοήθεια και εκτελούν τις ακόλουθες εντολές:
Ο 1ος μας επιτρέπει να αποθηκεύσουμε σε μορφή pdf έκθεση σε φάκελο που θα επιλέξουμε εμείς.
Ο 2ος μας προειδοποιεί για την ύπαρξη αρχείου με το ίδιο όνομα σε προκαθορισμένο φάκελο.
Αυτό που θέλω να πετύχω και δεν μπόρεσα, αν και έχω κάνει αρκετές προσπάθειες, να μπορέσω να "παντρέψω" τους δύο κώδικες. Δηλ. ένας κώδικας που με μία εντολή να γίνεται η εξαγωγή του pdf σε φάκελο της επιλογής μου και ταυτόχρονα να υπάρχει μία προειδοποίηση για το εάν στον ίδιο φάκελο υπάρχει ήδη αρχείο με το ίδιο όνομα.
Οι προναφερόμενοι κώδικες :
1ος αποθήκευση σε φάκελο επιλογής μας
Κώδικας:
Public Function PicFolder() As String
    Dim blnSelect As Boolean
    Dim fld As Object

    Set fld = Application.FileDialog(4)
    fld.AllowMultiSelect = False
    blnSelect = fld.Show
    If blnSelect Then
        PicFolder = fld.SelectedItems(1)
    End If
End Function

Private Sub cmdPDF_ΔελτιοΠαραγγελιας_Click()
Dim strFolder As String
    strFolder = PicFolder
    If strFolder <> "" Then
    DoCmd.OpenReport "RptΔελτία παραγγελίας", acViewPreview, , 
       "[ΟΝΟΜΑ_ΠΡΟΜΗΘΕΥΤΗ]=" & "'" & [ΟΝΟΜΑ_ΠΡΟΜΗΘΕΥΤΗ] & "'"
     
    DoCmd.OutputTo acOutputReport, "RptΔελτία παραγγελίας", acFormatPDF, 
     strFolder & "\" & CStr(ΟΝΟΜΑ_ΠΡΟΜΗΘΕΥΤΗ) & "_Σύνολο Παραγγελιών_" & Format(Now(),
      "yyyymmdd") & ".pdf", True
    Else
        MsgBox "Δεν επιλέξατε φάκελο"
    End If
    DoCmd.Close acReport, "RptΔελτία παραγγελίας", acSaveNo
End Sub
Ο 2ος προειδοποίηση για την ύπαρξη αρχείου με το ίδιο όνομα
Κώδικας:
Private Sub Εντολή482_Click()
    Dim FileName As String

    FileName = "C:\Users\" & "ΔΠ." & CStr(ΚωδΔελτίουπαραγγελίας) & _
               "_κ.κ.." & CStr(Κείμενο218) & "_" & Format((Κείμενο194),
                   "yyyymmdd") & ".pdf"

    If Dir(FileName) <> "" Then
        If MsgBox("Το αρχείο:" & vbCrLf & FileName & vbCrLf & _
                  "Υπάρχει. Να αντικατασταθεί;", vbCritical + vbYesNo) = vbOK Then
            DoCmd.OutputTo acOutputReport, "RptΔελτία παραγγελίας", acFormatPDF, 
               FileName, True
        End If
    Else
        DoCmd.OutputTo acOutputReport, "RptΔελτία παραγγελίας", acFormatPDF, 
            FileName, True
    End If
End Sub
Ευχαριστώ εκ των προτέρων
Τίμος
Απάντηση με παράθεση