PDF maken lukt niet altijd

[jhdw]

Goedenavond,

Ik doe weer een beroep op de kennis die op dit forum aanwezig is.
Het probleem wat ik nu heb is voor mij niet te verklaren (nou zegt dat niet zo veel).
Ik kan op 2 manieren een PDF bestand maken. De eerste is vanuit een keuzelijst met invoervak op een onafhankelijk formulier. Nadat er een keuze is gemaakt kan ik o.a. kiezen voor een PDF maken. Hierbij wordt gekeken of de map (bijv. jaar) al bestaat en zoniet dan wordt er een map aangemaakt. Daarna wordt het PDF bestand in deze map geplaatst (naam is afhankelijk van de informatie uit de keuzelijst. Dit werkt allemaal prima en ik kan net zoveel PDFjes achter elkaar maken als ik wil.
Maar ik heb ook een ander doorlopend formulier met in de detailregel een printknop. Nou is het de bedoeling als ik op de printknop druk, dat er gekeken wordt of er al een PDF gemaakt is of niet. Als er al een PDF gemaakt is dan wordt de PDF geopend (nog steeds goed).
Als er echter geen PDF gemaakt is, dan moet er een PDF aangemaakt worden: dit gaat de eerste keer goed. Als ik daarna in het volgende record hetzelfde doe, dan gaat het fout: ik krijg dan foutmelding 2501.
Het is lastig om een voorbeeldje te posten (BE en FE dB en veel privacy gevoelige informatie. Als het niet anders kan, dan moet ik een nieuwe dB maken met alleen een paar tabellen, queries ed en deze posten.
Zou iemand mij kunnen helpen dit probleem op te lossen.

Private Sub cmd_PDF_Click()
   
   On Error GoTo cmd_PDF_Click_Error
        
        DoCmd.Close acForm, "frm_printen"
        If IsNull(Me.ID_Factuur) Then
            Exit Sub
        ElseIf Not IsNull(Me.ID_Factuur) And IsNull(Me.Factuurdatum) Then
                    Call MsgBox("Deze factuur is nog niet geprint." _
                        & vbCrLf & "" _
                        & vbCrLf & "(De factuurdatum is daarom nog niet ingevuld!)" _
                        & vbCrLf & "" _
                        & vbCrLf & "Na het printen kun je hier wel de PDF maken/bekijken." _
                        , vbExclamation, Application.Name)
            DoCmd.OpenForm "frm_printen", acNormal
            DoCmd.Close acForm, Me.Name
            Me.Recalc
            Exit Sub
        ElseIf Me.Klant_Naam Like "*" & Chr(47) & "*" Then
            Select Case MsgBox("Je hebt een / in de naam staan!" _
                            & vbCrLf & "" _
                            & vbCrLf & "Dit mag niet." _
                            & vbCrLf & "" _
                            & vbCrLf & "Wil je de naam veranderen?" _
                            , vbYesNo Or vbExclamation Or vbDefaultButton1, Application.Name)
                    Case vbYes
                        DoCmd.OpenForm "frm_klant", acNormal ', , "[ID_klant] = " & Me.ID_klant
                        DoCmd.Close acForm, "frm_PDF_overzicht"
                    Case vbNo
                        Exit Sub
            End Select
        ElseIf Not IsNull(Me.ID_Factuur) And IsNull(Me.PDF_pad) Then
            DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE tbl_factuur SET tbl_factuur.PDF_pad = Null " _
                       & "WHERE (((tbl_factuur.ID_factuur)=[Formulieren]![frm_PDF_overzicht]![ID_factuur]));"
            DoCmd.SetWarnings False
            Me.Refresh
            Me.Repaint
            sMap = CurrentProject.Path & "\" & Year(Me.Factuurdatum)
                If Dir(sMap, vbDirectory) = "" Then MkDir sMap
                    sMap = sMap & "\" & [Forms]![frm_PDF_overzicht]![Factuurnummer] & " - " & [Forms]![frm_PDF_overzicht]![Klant_Naam] & ".pdf"
                    Me.PDF_pad = sMap
                    If Len(Dir(sMap, vbDirectory)) > 0 Then
                    Kill sMap
                    End If
                    DoCmd.OutputTo acOutputReport, "rpt_factuur_PDF_overzicht", acFormatPDF, sMap
                    Me.Refresh
                        If DCount("*", "qry_geen_PDF") = 0 Then
                            Me.kzl_geen_PDF.Enabled = False
                        Else
                            Me.kzl_geen_PDF.Enabled = True
                        End If
        Else
            Application.FollowHyperlink Me.PDF_pad, , True
        End If

   On Error GoTo 0
   Exit Sub

cmd_PDF_Click_Error:

      Select Case Err.Number
        Case 490
            Call CloseAllReports
            Call MsgBox("Deze link is niet goed!" _
                & vbCrLf & "" _
                & vbCrLf & "Ik maak wel weer een nieuwe." _
                , vbExclamation, Application.Name)
            DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE tbl_factuur SET tbl_factuur.PDF_pad = Null " _
                       & "WHERE (((tbl_factuur.ID_factuur)=[Formulieren]![frm_PDF_overzicht]![ID_factuur]));"
            DoCmd.SetWarnings False
            Me.Refresh
            Me.Recalc
            sMap = CurrentProject.Path & "\" & Year(Me.Factuurdatum)
                If Dir(sMap, vbDirectory) = "" Then MkDir sMap
                    sMap = sMap & "\" & [Forms]![frm_PDF_overzicht]![Factuurnummer] & " - " & [Forms]![frm_PDF_overzicht]![Klant_Naam] & ".pdf"
                    Me.PDF_pad = sMap
                    If Len(Dir(sMap, vbDirectory)) > 0 Then
                    Kill sMap
                    End If
                    DoCmd.OutputTo acOutputReport, "rpt_factuur_PDF_overzicht", acFormatPDF, sMap
                    Me.Refresh
                        If DCount("*", "qry_geen_PDF") = 0 Then
                            Me.kzl_geen_PDF.Enabled = False
                        Else
                            Me.kzl_geen_PDF.Enabled = True
                        End If
      End Select
    
 '   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmd_PDF_Click of VBA Document Form_frm_PDF_overzicht"

End Sub

Alvast bedankt voor het meedenken.

Gr. Jan

 

[gast0505]

Je kan ook pdf bestanden maken met de gratis PDF995 software. Download link:

http://www.mijnbestand.nl/Bestand-68ATM6LRJO6B.rar

In het .rar bestand (openen met winrar) zitten 2 bestanden, installeer eerst de "PDF995 [FIRST].exe", daarna de "PDF995.exe"

PS. Je kan ook op google zoeken: PDF995 (software).

Deze software lijkt mij namelijk makkelijker. In "apparaten en printers" krijg je een printer erbij met de naam PDF995. Deze selecteer je als je wil printen (bijv. vanuit word), dan komt er een scherm waar je de opslaglocatie kan instellen, en het PDF-bestand wordt gemaakt!

Gr. Gertjan

 

[jhdw]

Hallo Gertjan,

Dit is niet wat ik bedoel. Het probleem is niet maken van een PDF want dat lukt wel.
Het zit hem in de code die ik gebruik onder de knop op het doorlopende formulier. Na het openen van dit formulier kan ik de eerste PDF altijd maken; het probleem is dan om een tweede te maken. Als ik het formulier zou sluiten en opnieuw openen, dan kan ik er weer één maken. Ik ga er van uit dat dit ook anders zou moeten kunnen.

In ieder geval bedankt dat je er naar hebt willen kijken.

Gr. Jan

 

[gast0505]

Oh sorry dan heb ik het misschien verkeerd begrepen

Ik heb nu geen tijd meer, ik wil morgen wel even voor je kijken naar de code . Is het een .vbs bestand?

Gr. Gertjan

 

[OctaFish]

Zonder de db wordt het erg lastig om te kijken waar het fout gaat. Ik ben al een kwartier bezig om je code een beetje te fatsoeneren, en dat is eigenlijk al genoeg tijd voor nu .

 

[jhdw]

Hallo Gertjan,

Het is een Access 2010 dB en VBA code.

Hallo Michel,

Dat de code niet helemaal jofel is, komt ook doordat ik van alles aan het proberen ben (geweest). Ik heb nu de database ontdaan van privacy gevoelige informatie. De BE en FE constructie heb ik niet aangepast. Als de 2 bestanden op je eigen PC opgeslagen zijn en je opent de FE (test_formulier) dan wordt automatisch gevraagd waar de BE (Carolien_be) staat.
Ik ben er wel in geslaagd om het formulier "frm_printen" ook niet meer werkend te krijgen. Waarom ik daar geen PDF meer kan maken is mij een raadsel. In het doorlopend formulier "frm_PDF_overzicht" moet het veld "PDF_pad gevuld worden als je op de knop "P" drukt waarna de PDF geopend zou moeten worden.
Hopelijk wordt het met de dB iets duidelijker. Ik kon deze niet via mijnbestand.nl uploaden, daarom maar via wetransfer gedaan.

https://www.wetransfer.com/download...aebe4f90be9775a4f9ed7de120140611213735/1daccb

Alvast bedankt voor het meedenken.

Gr. Jan

 

[OctaFish]

Bij mij lukt het maken van de pdf in "frm_printen" prima. Al heb ik je code dus wel een beetje opgeschoond, en de IF vervangen door een Select Case. Maar daar zit ook het probleem niet. Ik zal nog even naar je doorlopend formulier kijken.

 

[OctaFish]

En dat werkt ook prima. (Na wat opschonen )

 

[jhdw]

Hallo Michel,

Bedankt voor je reactie en tijd die je er aan hebt willen besteden.

Zou je mij de opgeschoonde code kunnen sturen? Dan kan ik deze vanavond thuis nog even proberen in mijn originele dB

Allvast bedankt.

Gr. Jan

 

[OctaFish]

't Blijft een hoop code .

Private Sub Printkader_Click()
On Error GoTo Printkader_Click_Error

    Call CloseAllReports
    sMap = CurrentProject.Path & "\" & Year(Me.kzl_factuur.Column(3))
    sMap = sMap & "\" & Me.kzl_factuur.Column(1) & " - " & Me.kzl_factuur.Column(5) & ".pdf"
    
    Select Case Me.Printkader.Value
        Case 1
            DoCmd.OpenReport "rpt_factuur", acViewPreview, , "[ID_Factuur] = " & Me.kzl_factuur
        Case 2
            strDocName = "rpt_factuur_PDF"
            Me.txt_pad = sMap
            If Len(Dir(sMap, vbDirectory)) > 0 Then Kill sMap
            DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, sMap
            DoCmd.Close acReport, strDocName
            DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE tbl_factuur SET PDF_pad = " & Me.txt_pad _
                    & " WHERE (ID_factuur=" & Me.kzl_factuur & ");"
            DoCmd.SetWarnings True
            DoCmd.OpenReport "rpt_factuur", acPreview, , "[ID_factuur] = " & Me.kzl_factuur
        Case 3
            If Len(Me.kzl_factuur.Column(7)) = 0 Then
                Beep
                Call MsgBox("Er is geen emailadres van deze klant bekend!", vbExclamation, Application.Name)
                Me.Printkader.Value = 0
            Else
                strDocName = "rpt_factuur_PDF"
                Me.txt_pad = sMap
                If Len(Dir(sMap, vbDirectory)) > 0 Then Kill sMap
                DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, sMap
                DoCmd.Close acReport, strDocName
                DoCmd.SetWarnings False
                DoCmd.RunSQL "UPDATE tbl_factuur SET PDF_pad = " & Me.txt_pad _
                    & " WHERE (ID_factuur=" & Me.kzl_factuur & ");"
                DoCmd.SetWarnings True
                DoCmd.OpenReport "rpt_factuur", acNormal, , "[ID_factuur] = " & Me.kzl_factuur
                DoCmd.Close acReport, "rpt_factuur"
                DoCmd.SendObject acSendReport, "rpt_factuur_PDF", acFormatPDF, Me.kzl_factuur.Column(7), , , _
                     "Factuur: " & Me.kzl_factuur.Column(1) & " - " & Me.kzl_factuur.Column(2)
            End If
    End Select
   On Error GoTo 0
   Exit Sub

Printkader_Click_Error:

    Select Case Err.Number
        Case 2501
            Exit Sub
    End Select
End Sub

 

[jhdw]

Hallo Michel,

Ik heb de code gekopieerd naar mijn originele dB en alleen nog het "frm_printen" getest.
De PDF maken lukt, als de map niet bestaat wordt er een nieuwe map aangemaakt en de PDF wordt netjes weggeschreven.

Wat nog niet lukt is, dat het veld "PDF_pad" in de tabel "tbl_factuur" gevuld wordt. Deze blijft angstvallig leeg.

Zou je daar nog even naar willen kijken?

Alvast bedankt.

Gr. Jan

 

[jhdw]

Hallo Michel,

Na wat puzzelen tussen de voetbalwedstijden door is het mij toch nog gelukt om mijn laatste vraag zelf te beantwoorden.

Op het andere doorlopend formulier is het mij ook gelukt de code werkend te krijgen. Deze is nog een beetje langer als deze. Dit komt omdat er meer checks in zitten. Als alles gevuld wordt zoals nu in het "frm_printen" geschiedt, dan zijn een aantal van deze checks eigenlijk niet meer nodig. Dit vullen laat ik aan de uiteindelijke gebruiker over.

Private Sub Printkader_Click()
On Error GoTo Printkader_Click_Error

    Call CloseAllReports
    sMap = CurrentProject.Path & "\" & Year(Me.kzl_factuur.Column(3))
    sMap = sMap & "\" & Me.kzl_factuur.Column(1) & " - " & Me.kzl_factuur.Column(5) & ".pdf"
    
    Select Case Me.Printkader.Value
        Case 1
            DoCmd.OpenReport "rpt_factuur", acViewPreview, , "[ID_Factuur] = " & Me.kzl_factuur
        Case 2
            strdocname = "rpt_factuur_PDF"
            Me.txt_pad = sMap
            If Len(Dir(sMap, vbDirectory)) > 0 Then Kill sMap
            DoCmd.OutputTo acOutputReport, strdocname, acFormatPDF, sMap
            DoCmd.Close acReport, strdocname
            DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE tbl_factuur SET tbl_factuur.PDF_pad = [Formulieren]![frm_printen]![txt_pad] " _
                        & "WHERE tbl_factuur.ID_Factuur=[Formulieren]![frm_printen]![kzl_factuur];"
            DoCmd.SetWarnings True
            For x = 1 To 2
            DoCmd.OpenReport "rpt_factuur", acNormal, , "[ID_factuur] = " & Me.kzl_factuur
            Next x
        Case 3
            If Len(Me.kzl_factuur.Column(7)) = 0 Then
                Beep
                Call MsgBox("Er is geen emailadres van deze klant bekend!", vbExclamation, Application.Name)
                Me.Printkader.Value = 0
            Else
                strdocname = "rpt_factuur_PDF"
                Me.txt_pad = sMap
                If Len(Dir(sMap, vbDirectory)) > 0 Then Kill sMap
                DoCmd.OutputTo acOutputReport, strdocname, acFormatPDF, sMap
                DoCmd.Close acReport, strdocname
                DoCmd.SetWarnings False
                DoCmd.RunSQL "UPDATE tbl_factuur SET tbl_factuur.PDF_pad = [Formulieren]![frm_printen]![txt_pad] " _
                        & "WHERE tbl_factuur.ID_Factuur=[Formulieren]![frm_printen]![kzl_factuur];"
                DoCmd.SetWarnings True
                DoCmd.OpenReport "rpt_factuur", acNormal, , "[ID_factuur] = " & Me.kzl_factuur
                DoCmd.Close acReport, "rpt_factuur"
                DoCmd.SendObject acSendReport, "rpt_factuur_PDF", acFormatPDF, Me.kzl_factuur.Column(7), , , _
                     "Factuur: " & Me.kzl_factuur.Column(1) & " - " & Me.kzl_factuur.Column(2)
            End If
    End Select
    
   On Error GoTo 0
   Exit Sub

Printkader_Click_Error:

    Select Case Err.Number
        Case 2501
            Call MsgBox("Heb je misschien een / in de naam staan? Dit mag niet!", vbExclamation, Application.Name)
            Exit Sub
    End Select

End Sub

In ieder geval bedankt voor het meedenken en veel voetbal kijkplezier.

Gr. Jan