Speicherort von erstelltem PDF verbessern (Access)

Sternschnuppe @, Samstag, 24.11.2018, 20:09 (vor 24 Tagen)

Hallo zusammen,
ich arbeite an einer Access2010-Datenbank.
Per Button im Formular erzeuge ich aus einem Bericht ein PDF-Dokument, welches automatisch unter dem gefilterten Datensatz in einem Anlagefeld abgespeichert wird. Dieses funktioniert auch gut.
Problem:
Gleichzeitig wird diese PDF-Datei auch an den zuletzt gespeicherten Ort hinterlegt. Dieses darf aus Datenschutzgründen nicht.

Kann mir jemand sagen bzw. helfen, wie ich mein Modul verändern muss, um nur in der aktuellen Datenbank das PDF zu speichern?
Über Rückmeldungen und Hilfestellungen freue ich mich sehr :-)


Modul1:

Option Compare Database
Option Explicit

Function GetNamePath()
     Dim MyDB As Database

     Set MyDB = CurrentDb()
     GetNamePath = MyDB.Name
 End Function


Private Sub cmdDeckblattNeu_Click()
Dim BerichtsName As String
Dim sPfad   As String
Dim fileName As String
Dim Filter As String
Dim sAnlage As String
Dim criteria As String
     
'Info über Speicherort, Berichtsname, Speichername, Filteroption (persoID)
BerichtsName = "Deckblatt"
sPfad = GetNamePath()
sAnlage = Format$(Now, "yyyy-mm-dd_hh.mm") & " " & BerichtsName & " - " & Me!persoNameAnzeigenNachVor & ".pdf"
Filter = "persoID = " & Me![persoID]

'Bericht wird in der Handakte der Person gespeichert
DoCmd.OpenReport BerichtsName, acPreview, , Filter
DoCmd.OutputTo acOutputReport, "Deckblatt", acFormatPDF, sAnlage, , , , acExportQualityScreen
Call StoreBLOB(sAnlage, sPfad, "tblPersonen", "persoHandakte", True, "persoID", Me!persoID)
DoCmd.Close acReport, BerichtsName, acSaveNo

Modul2:

Function StoreBLOB(strFilename As String, strACCDB As String, strTable As String, _
                             strFieldAttach As String, Optional boolEdit As Boolean, _
                           Optional strIDField As String, Optional varID As Variant, _
                                          Optional strAttachment As String) As Boolean
    Dim fld2 As DAO.Field2
    Dim rstDAO As DAO.Recordset2
    Dim rstACCDB As DAO.Recordset2
    Dim MyDB As Database
    On Error GoTo ErrHandler
    Set MyDB = OpenDatabase(strACCDB)
    Set rstDAO = MyDB.OpenRecordset("SELECT * FROM [" & strTable & "]", _
                                                                        dbOpenDynaset)
    If boolEdit Then
        If IsNull(varID) Then Err.Raise vbObjectError + 1, , _
                                                       "Keine Datensatz-ID angegeben!"
        rstDAO.FindFirst "CStr([" & strIDField & "])='" & CStr(varID) & "'"
        If rstDAO.NoMatch Then Err.Raise vbObjectError + 2, , _
                                      "Datensatz mit ID " & varID & " nicht gefunden!"
        rstDAO.Edit
    Else
        rstDAO.AddNew
    End If
    Set rstACCDB = rstDAO(strFieldAttach).Value
    If boolEdit Then
        If rstACCDB.EOF Then 'Fall 1: Es gibt noch keine Anlagen; > neue Anlage
            rstACCDB.AddNew
        Else
            Do While Not rstACCDB.EOF
                rstACCDB.MoveNext
            Loop
            rstACCDB.FindFirst "[FileName]='" & strAttachment & "'"
            'Fall2: Es gibt keine Anlage mit dem Namen in sAttachment: > neue Anlage
            'Fall3: Anlage gefunden; dann editieren
                If rstACCDB.NoMatch Then
                    rstACCDB.AddNew
                Else
                    rstACCDB.Edit
                End If
        End If
    Else                'Dateien per VBA in Anlage-Felder importieren und exportieren
        rstACCDB.AddNew
    End If

... Code geht noch weiter ...


gesamter Thread:

 RSS-Feed dieser Diskussion

powered by my little forum