Printing Reports that are mentioned in table

[Gerrit.B]

Is it possible to add in my table with customers to add field where I can put report names or report ID's, and print these reports with VBA.

I then want to create a loop to export all report to pdf files.

 

[Gerrit.B]

I have the code almost working, see below.

Option Compare DatabaseOption Explicit


Const sDefaultPath As String = "C:\Temp"


Function ExportCustomerReports()


    On Error GoTo ExportReports_Err


    If Len(Dir(sDefaultPath, vbDirectory)) = 0 Then
        MyMkDir sDefaultPath
    End If


    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim strRptName As String
    Dim intCounter As Integer


    'strSQL = "SELECT [MSysObjects]![Name] AS Report, [tblShipments]![OrderNumber] AS OrderNumber " & vbCrLf & _
             "FROM (tblCustomerReports INNER JOIN MSysObjects  " & vbCrLf & _
             "ON tblCustomerReports.Report = MSysObjects.Name)  " & vbCrLf & _
             "INNER JOIN tblShipments ON (tblCustomerReports.ShipmentType = tblShipments.ShipmentType)  " & vbCrLf & _
             "AND (tblCustomerReports.TransporttationID = tblShipments.Transportation)  " & vbCrLf & _
             "AND (tblCustomerReports.ContactID = tblShipments.Customer) " & vbCrLf & _
             "WHERE (((MSysObjects.Type)=-32764)  " & vbCrLf & _
             "AND ((tblShipments.ShipmentID)=[Forms]![frmShipments]![ShipmentID]));"
    strSQL = "SELECT [MSysObjects]![Name] AS Report, [tblShipments]![OrderNumber] AS OrderNumber " & vbCrLf & _
                "FROM (tblCustomerReports INNER JOIN MSysObjects ON tblCustomerReports.Report = MSysObjects.Name)  " & vbCrLf & _
                "INNER JOIN tblShipments ON (tblCustomerReports.ContactID = tblShipments.Customer)  " & vbCrLf & _
                "AND (tblCustomerReports.TransporttationID = tblShipments.Transportation)  " & vbCrLf & _
                "AND (tblCustomerReports.ShipmentType = tblShipments.ShipmentType) " & vbCrLf & _
                "WHERE (((tblShipments.ShipmentID)=1165));"
       
    Set rst = DBEngine(0)(0).OpenRecordset(strSQL)


    Do While Not rst.EOF
        Debug.Print rst!Report
        strRptName = rst!Report


        DoCmd.OutputTo acOutputReport, strRptName, "PDFFormat(*.pdf)", sDefaultPath & Mid(rst!Report, 4, 55) & ".pdf", False, "", 0, acExportQualityPrint
        'MsgBox strRptName & " " & sDefaultPath '& Mid(rst!Report, 4, 55) & ".pdf"


        rst.MoveNext
        intCounter = intCounter + 1    ' increase value of intCounter by 1
    Loop


ExportReports_Exit:
    Exit Function


ExportReports_Err:
    'MsgBox Error$
    Resume ExportReports_Exit


End Function

Only when i change "WHERE (((tblShipments.ShipmentID)=1165));" to "AND ((tblShipments.ShipmentID)=[Forms]![frmShipments]![ShipmentID]));"

it isn't working anymore.

What could be wrong?

 

[Micron]

The form isn't open? The form is a subform? Either would do this.
Name is a reserved word and should not be used for any db object. Why use a system table when you could get much more by using a report table (tblReports) such as
- list your report names
- have useful descriptions
- impose access restrictions based on user profile
- organize into groups
- associate a directory path for each
- link a report ID to a customer, process, form (pretty much anything)
- etc.

Also,
- you have Option Explicit but no declaration for any/most variables (such as rst). How does this even work without producing an error?
- you're using DBEngine(0) (0) when you probably should be using CurrentDb. The latter is a copy of the current database; the former a pointer to it. Should you over-use this, you can raise errors by having 2 or more pointers to the same db at the same time. I mention this because I suspect you copied this code from somewhere, but are not fully aware of some things in it (or not in it as mentioned above).

 

[Gerrit.B]

Hi Micron,

I solved my problem by change my SQL to Make table query, and then use code below.

Option Compare DatabaseOption Explicit


Const sDefaultPath As String = "\\12.33.150.43\Desktops\"


Function ExportCustomerReports()


    On Error GoTo ExportReports_Err
    
    Dim StrUsername As String
    StrUsername = Environ("UserName")


    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim strRptName As String
    Dim strOrderNumber As String
    Dim intCounter As Integer
    Dim Path As String
    
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "MT_TempCustomerReports"
    DoCmd.SetWarnings True


    strSQL = "SELECT * FROM TempCustomerReports"
       
    Set rst = DBEngine(0)(0).OpenRecordset(strSQL)
    
    Do While Not rst.EOF
        Debug.Print rst!Report
        strRptName = rst!Report
        strOrderNumber = rst!OrderNumber
        


    Path = sDefaultPath & StrUsername & "/" & strOrderNumber & "/"
        
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MyMkDir Path
    End If


        DoCmd.OutputTo acOutputReport, strRptName, "PDFFormat(*.pdf)", Path & Mid(rst!Report, 4, 55) & ".pdf", False, "", 0, acExportQualityPrint
        
        rst.MoveNext
        intCounter = intCounter + 1    ' increase value of intCounter by 1
    Loop


ExportReports_Exit:
    Exit Function


ExportReports_Err:
    MsgBox Error$
    Resume ExportReports_Exit


End Function

 

[Micron]

If you're interested, here's a few code comments.
I guess the openquery runs an action query. What do you think happens to the warnings setting if the action raises an error?
You don't appear to make use of the counter, so why have it?
Your exit block is incomplete (see first comment for one clue as to why). Also incomplete because you create objects but don't destroy them.
Error$ is very old - from about version 2.0 Should be using Err.Number. Plus, the number by itself isn't much good to anyone. A better handler would include a description, and if other users are involved, perhaps a direction, such as "call database administer" or something.
Anyway, you appear to be making progress, but this procedure is a bit shaky for the above reasons.

 

[Gerrit.B]

Could you please update my code, to how it should be?
Then I can test it, and can also learn from it.

 

[Micron]

OK. Some of this isn't about correction, but another way of doing things. This code is untested, so if it errors out, look for mistakes I made.

Option Compare Database 'these are only at the top of a module, not every procedure, right?
Option Explicit
Const sDefaultPath As String = "\\12.33.150.43\Desktops" 'this declaration is at the top of the module too?

Sub ExportCustomerReports()'your function returns nothing, so it could be a sub
'Procedure declarations first; not "wrong", just better. PATH is a reserved word. To avoid this your naming
'convention should include type prefixes. This way, when reading far down in the code, you don't have to 
'scroll up to see what type the variable is. I make some exceptions, such as rs or rst.

'I sometimes use CurrentDb and then the required method. 
'Setting a db variable here instead since there's more than 1 usage for it, plus it illustrates an option you have
Dim db As DAO.Database 
Dim rst As DAO.Recordset
Dim strRptName As String, StrUsername As String
Dim strOrderNumber As String, strPath As String
 
On Error GoTo errHandler
StrUsername = Environ("UserName")
Set db = CurrentDb

db.Execute "MT_TempCustomerReports", dbFailOnError
Set rst = db.OpenRecordset "SELECT * FROM TempCustomerReports" 'so short that variable isn't really needed

If Not (rst.BOF And rst.EOF) Then 'if true, there are no records. This test should be made 1st
  rst.MoveFirst 'no guarantee that you will start at the beginning if rst is based on a table. Good habit.
  Do While Not rst.EOF
    'Debug.Print rst!Report
    strRptName = rst!Report
    strOrderNumber = rst!OrderNumber    
    strPath = sDefaultPath & StrUsername & "/" & strOrderNumber & "/"
        
    If Len(Dir(strPath, vbDirectory)) = 0 Then MyMkDir strPath

    DoCmd.OutputTo acOutputReport, strRptName, "PDFFormat(*.pdf)", strPath & Mid(rst!Report, 4, 55) & ".pdf", False, "", 0, acExportQualityPrint
        
   rst.MoveNext
   'you didn't aswer what the counter was for so I removed it
  Loop
End IF

exitHere:
Set db = Nothing
Set rst = Nothing
Exit Function

errHandler:
'if you want custom message, use strMsg and assign text to it. You can use If or Select Case block to deal with specific
'error numbers. Several err numbers can be individually dealt with this way. This one is just general and simple. 

MsgBox "Error " & err.Number & ": " & err.Description
Resume exitHere

End Sub

 

[Gerrit.B]

Hi Micron,

I just tested your code, and I got an error on line below:

Set rst = db.OpenRecordset "SELECT * FROM TempCustomerReports" 'so short that variable isn't really needed

 

[Micron]

Please look at the tips in my signature. Especially #1

 

[Gerrit.B]

I did not get an error, it just colored red