Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

I have a report that I group on a field. I want to the report split into individual PDFs for each. 1

Status
Not open for further replies.

keun

Technical User
Jul 15, 2005
262
US
I have found many threads about this topic on many other forums, and a few here on tek-tips. I have tried a bunch of snippets of code from various sources but I cannot get any of them to execute.

I run a report called "rpt_qrySPU03"
It is grouped on a field called UserOrgInd
I want to print the report to individual PDFs where each PDF contains just the data for UserOrgInd and where the name of the PDF is each UserOrgInd and .pdf.
I have the small bit of code to run the reports and convert to PDF, but every technique I have tried to loop through a list of the UserOrgInd field has failed. I'm not even close.
I created a table called tblOrgs which has a field called UserOrg. This UserOrg field contains a unique list of the UserOrgInd so I can use it as a SELECT criteria and as the parameter for naming the PDF.


Here is the code that I use to run the report. Can you help me add the bits I need to
a. reference my table of UserOrgInd
b. start the loop
c. create each grouped PDF per UserOrgInd and named per the UserOrgInd parameter
d. stop the loop
Code:
Private Sub Command1_Click()
Dim MyPath As String
Dim MyFilename As String
Dim rs As DAO.Recordset

MyPath = "W:\report"
MyFilename = "blah" & ".pdf"

    DoCmd.OpenReport "rpt_qrySPU03", acViewPreview, "qrySPU03"
    DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & "\" & MyFilename, False

   
End Sub

Also an example of something that is totally not working and I've stepped on this so many times it's baby food. I know there a ton of stuff missing and it's embarrassing even posting this:
Code:
Private Sub Command3_Click()
'Load recordset
      Dim strSQL As String
      strSQL = "SELECT * FROM tblOrgs"
      Set db = CurrentDb
      Set rs = OpenRecordset(tblOrgs)
     
     
      Dim strReportName As String
      strReportName = "rpt_qrySPU03"
     
    'Loop over records
   Do Until rs.EOF
      'To open a report
        DoCmd.OpenReport strReportName, acViewNormal, , "UserOrg=" & rsComp!UserOrg, acHidden
        DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & UserOrg, False
     
      rsComp.MoveNext
    Loop
     
    'Cleanup
      Set rsComp = Nothing
End Sub
 
Your basic idea looks correct. You have a lot of inconsistencies. Here is a cleaner version. I have some temp variables to allow debugging. You should be able to just change the values of the constants to make it work. You need to learn how to debug.

Code:
Public Sub ExportToPDF()
  Const Folder = "C:\Users\test.name\"
  Const Domain = "qryBudgetNew"
  'Domain can be table name, query name, or sql statement that provides the values to loop
  Const LoopedField = "departmentID"
  Const ReportName = "rptBudgetCombined"
  
  Dim rs As DAO.Recordset
  Dim LoopedFieldValue As Long
  Dim FileName As String
  Dim FullPath As String
  Dim strWhere As String
  Set rs = CurrentDb.OpenRecordset(Domain)
 
  Do While Not rs.EOF
    LoopedFieldValue = rs.Fields(LoopedField)
    FileName = LoopedFieldValue & ".PDF"
    'The field may be a text field. It then must be surrounded in singlequotes. If so uncomment below
    'LoopedFieldValue = "'" & LoopedFieldValue & "'"
    FullPath = Folder & FileName
    strWhere = LoopedField & " = " & LoopedFieldValue
    Debug.Print FullPath
    Debug.Print strWhere
    DoCmd.OpenReport ReportName, acViewPreview, , strWhere
    DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, FullPath
    DoCmd.Close acReport, ReportName
    rs.MoveNext
  Loop
End Sub

a few of your problems

Set rs = OpenRecordset(tblOrgs)
'Needs to be set rs = db.Openrecordset

DoCmd.OpenReport strReportName, acViewNormal, , "UserOrg=" & rsComp!UserOrg, acHidden
'if UserOrg is text then : UserOrg = '" & rsComp!userOrg & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & UserOrg, False
' Mypath is not defined in this method also needs to end in a ' If you debug this it does not produce a valid fullpath
' You never close all the open hidden files.
 
Thanks a bunch. I am going to start to sort through this; probably not until Monday but I really appreciate the guidance.

I joined this forum in 2005. I am still a hack.
 
I am getting an error as I picture below. I am going to try to figure out what is gong wrong by enlisting the help of some informed people here in the office. Anything you can add is helpful!

</a>
Pjqjknt.png


I joined this forum in 2005. I am still a hack.
 
The following code is "working" - I changed "Dim LoopedFieldValue As Long" to "Dim LoopedFieldValue As String"

By working, I mean it is looping, but my PDFs are not getting saved.


Code:
Private Sub Command3_Click()

  Const Folder = "c:\path"
  Const Domain = "tblOrgs"
  'Domain can be table name, query name, or sql statement that provides the values to loop
  Const LoopedField = "UserOrgInd"
  Const ReportName = "rpt_qrySPU03"
  
  Dim rs As DAO.Recordset
  Dim LoopedFieldValue As String
  Dim FileName As String
  Dim FullPath As String
  Dim strWhere As String
  Set rs = CurrentDb.OpenRecordset(Domain)
 
  Do While Not rs.EOF
    LoopedFieldValue = rs.Fields(LoopedField)
    FileName = LoopedFieldValue & ".PDF"
    'The field may be a text field. It then must be surrounded in singlequotes. If so uncomment below
    LoopedFieldValue = "'" & LoopedFieldValue & "'"
    FullPath = Folder & FileName
    strWhere = LoopedField & " = " & LoopedFieldValue
    Debug.Print FullPath
    Debug.Print strWhere
    DoCmd.OpenReport ReportName, acViewPreview, , strWhere
    DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, FullPath
    DoCmd.Close acReport, ReportName
    rs.MoveNext
  Loop
End Sub

I joined this forum in 2005. I am still a hack.
 
Forget that last. It was not outputting because I was missing the close "\" in Const Folder = "c:\path"

I joined this forum in 2005. I am still a hack.
 
Let me ask you this - the process stops when it hits a "LoopedField" containing an apostrophe. Is the apostrophe in the field the cause of the Run-time error 3075?

I joined this forum in 2005. I am still a hack.
 
Code:
strWhere = LoopedField & " = " & Replace(LoopedFieldValue, "'", "''")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
PHV: using that code throws a Syntax Error (missing operator) in the UserOrg query expression error at:

Code:
DoCmd.OpenReport ReportName, acViewPreview, , strWhere

BUT, I got this working using another means. I created a unique identifier for each UserOrg and I am able to loop through on the identifier but then name the files using another variable. It seems to be working accurately. If anyone wants to comment on this and let me know if it is in anyway problematic I appreciate it. I created a query that pulls a unique list of UserOrgs and assigns the unique ID called MinOfID, I added that field to my report, this the field I loop on. You can see that I have the variables (is that what they are called?) FileName, NewFileName, and NewNewFileName; I am not sure if this is the most efficient way to get here.


Code:
Private Sub Command3_Click()

  Const Folder = "C:\path\"
  Const Domain = "qrySPU04ListOfOrgs"
  'Domain can be table name, query name, or sql statement that provides the values to loop
  Const LoopedField = "MinOfID"
  Const NewFileName = "UserOrg"
  Const ReportName = "rpt_qrySPU03"
  
  Dim rs As DAO.Recordset
  Dim LoopedFieldValue As Long
  Dim FileName As String
  Dim FullPath As String
  Dim strWhere As String
  Dim NewNewFileName As String
  Set rs = CurrentDb.OpenRecordset(Domain)
 
  Do While Not rs.EOF
    LoopedFieldValue = rs.Fields(LoopedField)
    NewNewFileName = rs.Fields(NewFileName)
    FileName = NewNewFileName & ".PDF"
    'The field may be a text field. It then must be surrounded in singlequotes. If so uncomment below
    'LoopedFieldValue = "'" & LoopedFieldValue & "'"
    FullPath = Folder & FileName
    strWhere = LoopedField & " = " & LoopedFieldValue
    Debug.Print FullPath
    Debug.Print strWhere
    DoCmd.OpenReport ReportName, acViewPreview, , strWhere
    DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, FullPath
    DoCmd.Close acReport, ReportName
    rs.MoveNext
  Loop
End Sub


I joined this forum in 2005. I am still a hack.
 
Code:
strWhere = LoopedField & "='" & Replace(rs.Fields(LoopedField), "'", "''") & "'"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top