DoCmd.OutputTo word gecancelled

[Artemiss]

Beste allemaal,

Ik zit al een tijdje te klooien met een macro om de records in een rapport als individuele Pdf's op te slaan.
Het gekke is dat de macro de ene keer helemaal naar behoren werkt, maar dat andere keren de macro stop op de DoCmd.OutputTo met de foutmelding "Fout 2501 tijdens uitvoering: De actie OutputTo is geannuleerd"
Het aantal records dat wel goed gaat is steeds de verschillend, soms stopt hij bijvoorbeeld al na 3 records en andere keer bijvoorbeeld 20 en soms loopt hij ook gewoon door alle records heen, in dit geval 42 stuks.
Ik heb vergelijkbare vragen gevonden in forums, maar eigenlijk nergens de oplossing.

Wat ik ontdekt heb, is dat als ik na de error Foutopsporing kies en dan weer op Play druk, hij gewoon weer zonder problemen doorgaat. Daardoor heb ik het idee dat hij niet altijd genoeg tijd heeft, vandaar alle DoEvents in de code. Maar dit helpt dus niet. Heeft iemand een idee hoe ik kan zorgen dat hij pas OutputTo doet op het moment dat hij er klaar voor is? Of is dat het probleem misschien helemaal niet?
Jullie hulp in deze wordt erg gewaardeerd

Onderstaand de code:

Sub Vooschotfakturen_opslaan()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String

    Set db = CurrentDb()

    Set rs = db.OpenRecordset("SELECT [Faktuurnr], [Kontraktnr], [DebiteurNaam], [Faktuurdatum] FROM [Voorschotfakturen]", dbOpenSnapshot)
    
    DoCmd.OpenReport "Voorschotfaktuur", acViewReport

    Do While Not rs.EOF
      
        DoEvents
        If Dir(CurrentProject.Path & "\" & rs("Kontraktnr") & " - " & rs("DebiteurNaam") & "\", vbDirectory) = Empty Then MkDir CurrentProject.Path & "\" & rs("Kontraktnr") & " - " & rs("DebiteurNaam") & "\"
        
        DoEvents
        mypath = CurrentProject.Path & "\" & rs("Kontraktnr") & " - " & rs("DebiteurNaam") & "\"
        temp = rs("Faktuurnr")
        MyFileName = rs("Faktuurnr") & ";" & rs("Faktuurdatum") & ".PDF"
        
        DoEvents
        With Reports!Voorschotfaktuur
            .FilterOn = False
            .Filter = "[Faktuurnr]='" & temp & "'"
            .FilterOn = True
        End With
        DoEvents
        'DoCmd.PrintOut , , , , 1
        DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
        DoEvents

        rs.MoveNext
    Loop
    
    DoCmd.ShowAllRecords
    DoCmd.Close acReport, "Voorschotfaktuur"
    rs.Close
    Set rs = Nothing
    Set db = Nothing

End Sub

 

[Artemiss]

Oorzaak gevonden

Omdat ik niet zo heel goed ben ik wachten ben ik zelf ook nog even doorgegaan met het zoeken naar een oplossing op de diverse forums en daar kwam ik toch iets interessants tegen. Daar las ik namelijk dat de locatie waar het bestand werd opgeslagen voor de problemen zorgde, in de ene map ging het zonder problemen en in een andere niet... En toen begon mij iets te dagen...

Wat jullie aan mijn code niet konden zien is dat mijn database is opgeslagen in Dropbox en dat de PDF dus ook worden weggeschreven naar Dropbox. Wat Dropbox natuurlijk altijd doet, zodra een bestand wordt toegevoegd is deze zo snel mogelijk synchroniseren. Op het moment dat hij hiermee bezig is, is de betreffende map in gebruik en kan je even niets daarin opslaan.
Ik heb nu het opslagpad tijdelijk even aangepast naar C:\Test\ en nu loopt de macro zonder problemen door (reeds 5 x met 164 records, voor mij voldoende bewijs dat het nu werkt)

Voor mij lost dit het probleem op, want de database is voor iemand anders bedoelt die hem gewoon op zijn computer gaat zetten en dus niet met de synchronisatie van Dropbox te maken heeft.
Mocht je de bestanden wel perse in een dergelijke map op willen slaan, dan kun je ze misschien eerst ergens anders opslaan en dan naar de gewenste locatie laten kopiëren. Die oplossing werd in de thread die mij het licht deed zien gegeven en wilde ik jullie niet onthouden...

 

[OctaFish]

Altijd fijn als vraagstellers hun eigen vragen oplossen . Onbedoeld geef je met je vraag wel weer aan hoe belangrijk het is om zoveel mogelijk informatie te geven om een zinvol antwoord te kunnen zoeken. Je code kan nog iets simpeler, zodat je ook wat minder hoeft aan te passen als (bijvoorbeeld) de naamgeving tóch anders moet. Ik zou het dus zo schrijven:

        myPath = CurrentProject.Path & "\" & rs("Kontraktnr") & " - " & rs("DebiteurNaam") & "\"
        If Dir(myPath, vbDirectory) = Empty Then MkDir myPath