Solved Saving separate reports to PDF using VBA

Thanks for the tip Gasman.
 
I know I'm marked this thread as solved, but I've got a couple of small questions to ask. I've made a slight adjustment to the code (see below) in order to save only the last record as a PDF file.

So my first question is, is the way I've gone about it the most efficient? Do I really need a loop to achieve this?

Secondly, I'd like the user (me!) to input an invoice number (or to type letter L to indicate last record) and then it saves that particular record to PDF. What's the easiest way to go about saving a particular record based on it's invoice number?

Many thanks for your help.

Code: 
Private Sub Command0_Click()


    Dim rs                    As DAO.Recordset
    Dim sFolder               As String
    Dim sFile                 As String


    On Error GoTo Error_Handler


    sFolder = "D:\Documents\Orchestra\Invoices\Invoice files\"


    Set rs = CurrentDb.OpenRecordset("SELECT Invoice_Number FROM Q_Invoices", dbOpenSnapshot)
 
    With rs
        .MoveLast
        Do While Not .EOF
            DoCmd.OpenReport "R_Invoices_PDF", acViewPreview, , "[Invoice_Number]=" & ![Invoice_Number], acHidden
            sFile = Nz(![Invoice_Number], "") & ".pdf"
            sFile = sFolder & sFile
            DoCmd.OutputTo acOutputReport, "R_Invoices_PDF", acFormatPDF, sFile
            'If you wanted to create an e-mail and include an individual report, you would do so now
            DoCmd.Close acReport, "R_Invoices_PDF"
            .MoveNext
        Loop
    End With


    'Application.FollowHyperlink sFolder    'Optional / Open the folder housing the files


Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub


Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: cmd_GenPDFs_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Sub
 
Last edited:
If you want the last record then MoveLast as you appear to be doing? No need for MoveNext in that case.?
If you want a particular record use FindFirst. Again, no need for a move next.?

If this was me, I would probably try on the button.

If nothing in the relevant form control, then loop through the whole recordset as you were doing.
If "L" then use last record logic.
Else use Findrecord logic.

All can be done with one button click event and a bit of decision making.?

Any time you start repeating code, I believe there is a flaw in the logic. ? If you have to amend one section, you have to do the same in the other(s).?
 
Thanks Gasman. I tried using FindFirst, but I don't know how to make it work. I've showed how I've tried below.

I need to integrate your other suggestions as well, but I'd like to make this bit work first.

Many thanks.

Code: 
Private Sub Command0_Click()


    Dim rs                    As DAO.Recordset
    Dim sFolder               As String
    Dim sFile                 As String


    On Error GoTo Error_Handler


    sFolder = "D:\Documents\Orchestra\Invoices\Invoice files\"


    Set rs = CurrentDb.OpenRecordset("SELECT Invoice_Number FROM Q_Invoices", dbOpenSnapshot)
  
    With rs
        .FindFirst ("1088")
        Do While Not .EOF
            DoCmd.OpenReport "R_Invoices_PDF", acViewPreview, , "[Invoice_Number]=" & ![Invoice_Number], acHidden
            sFile = Nz(![Invoice_Number], "") & ".pdf"
            sFile = sFolder & sFile
            DoCmd.OutputTo acOutputReport, "R_Invoices_PDF", acFormatPDF, sFile
            'If you wanted to create an e-mail and include an individual report, you would do so now
            DoCmd.Close acReport, "R_Invoices_PDF"
            .MoveNext
        Loop
    End With


    'Application.FollowHyperlink sFolder    'Optional / Open the folder housing the files


Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub


Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: cmd_GenPDFs_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Sub
 
Ok, this seems to work now. Thanks for your help.

Code: 
Private Sub Command0_Click()


    Dim rs                    As DAO.Recordset
    Dim sFolder               As String
    Dim sFile                 As String


    On Error GoTo Error_Handler


    sFolder = "D:\Documents\Orchestra\Invoices\Invoice files\"


    Set rs = CurrentDb.OpenRecordset("SELECT Invoice_Number FROM Q_Invoices", dbOpenSnapshot)
    
    With rs
        .FindFirst "[Invoice_Number] = 1088"
            DoCmd.OpenReport "R_Invoices_PDF", acViewPreview, , "[Invoice_Number]=" & ![Invoice_Number], acHidden
            sFile = Nz(![Invoice_Number], "") & ".pdf"
            sFile = sFolder & sFile
            DoCmd.OutputTo acOutputReport, "R_Invoices_PDF", acFormatPDF, sFile
            'If you wanted to create an e-mail and include an individual report, you would do so now
            DoCmd.Close acReport, "R_Invoices_PDF"
            .MoveNext
    End With


    'Application.FollowHyperlink sFolder    'Optional / Open the folder housing the files


Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub


Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: cmd_GenPDFs_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Sub
 
Tip: With the Last and FindFirst you can use Exit Do from your EOF loop. ?
Obviously you need to replace the 1088 and concatenate the control name with the "[Invoice_Number] = "
 
Thanks for the tip. I've deleted the do loop now. I've scrapped the "enter L for last record" idea for now. I added an InputBox for getting the invoice number from the user. It's all working well now.

The only thing is, if I enter a number outside of the invoice range, it saves the first record. This isn't a problem, as it's only me who'll ever use this. I might look into a solution later though.

I've got another slightly unrelated question, but it applies to another similar code for something else, so perhaps I'll start a new thread for that.

Code: 
Private Sub Command0_Click()


    Dim rs As DAO.Recordset
    Dim sFolder, sFile, answer As String
  
    answer = InputBox("Enter invoice number to save as PDF")


    On Error GoTo Error_Handler


    sFolder = "D:\Documents\Orchestra\Invoices\Invoice files\"


    Set rs = CurrentDb.OpenRecordset("SELECT Invoice_Number FROM Q_Invoices", dbOpenSnapshot)
  
    With rs
        .FindFirst "[Invoice_Number] =" & answer
            DoCmd.OpenReport "R_Invoices_PDF", acViewPreview, , "[Invoice_Number]=" & ![Invoice_Number], acHidden
            sFile = Nz(![Invoice_Number], "") & ".pdf"
            sFile = sFolder & sFile
            DoCmd.OutputTo acOutputReport, "R_Invoices_PDF", acFormatPDF, sFile
            'If you wanted to create an e-mail and include an individual report, you would do so now
            DoCmd.Close acReport, "R_Invoices_PDF"
            .MoveNext
    End With


    'Application.FollowHyperlink sFolder    'Optional / Open the folder housing the files


Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Exit Sub


Error_Handler:
    If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: cmd_GenPDFs_Click" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Sub
 
You must log in or register to reply here.

Similar threads

H
Solved Problem with delete Qry
Replies
3
Views
539
HillTJ
H
B
Outlook - Filtered Unread, Server duplicate emails & think Unread = False not work so errors
Replies
6
Views
282
bignose2
B
P
Create seperate PDF Files from a report Base on a query with more than 300 records
Replies
5
Views
794
Uncle Gizmo
Uncle Gizmo
P
Update field with last payment date
Replies
17
Views
289
Minty
Minty
N
Solved How to grab the last updated record in a table
Replies
10
Views
330
June7
June7

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom