Help with vba code - PDF reports run but I don't see any files being created

[penndro]

When I run my code it runs through the report records but nothing is printing and it is not creating any folders to put the reports into. First it should create a folder for CompMgr and add uniquely named PDF files for each employee.

VBA Experts can you please help me with this? Have been working on it a for 4 days now and cant get it to work.

 Public Function PrintStatements()

Dim strDist             As String
Dim rsDist              As Recordset
Dim strEmp              As String
Dim rsEmp               As Recordset
Dim strCompMgr        As String
Dim rsCompMgr           As Recordset
Dim strEEPlan         As String
Dim rsEEPlan        As Recordset
Dim strLocation         As String
Dim dbStatements        As Database
Dim intDistCount        As Integer
Dim intFileCounter      As Integer
Dim strDirectoryName    As String
Dim strReportFilter     As String
Dim strReportPath       As String
Dim strReportFileName   As String
Dim strReportSQL        As String
Dim qryReport           As QueryDef
Dim strPlanType         As String
    
    On Error GoTo Err_ExportAllStatements
    
    DoCmd.SetWarnings False
    
    mstrOutgoingDirectory = "C:\Desktop\2012 Statements\"
    'If Directory exists, delete before adding statements
    DeleteFolders (mstrOutgoingDirectory)
    intFileCounter = 1
    
    Set dbStatements = CurrentDb
    
    strDist = "SELECT tbl_FolderPath.CompMgr" & _
    "FROM tbl_FolderPath" & _
    "HAVING (((tbl_FolderPath.CompMgr) Is Not Null))" & _
    "GROUP BY tbl_FolderPath.CompMgr" & _
    "ORDER BY tbl_FolderPath.CompMgr, tbl_FolderPath.[Full Name]"

Debug.Print strDist

    Set rsDist = dbStatements.OpenRecordset(strDist)
    strCompMgr = rsDist("CompMgr")
   
Debug.Print strCompMgr
   
    If Not rsDist.EOF Then
        'Get the total number of Distribution points we will process for the progress form
        rsDist.MoveLast
        intDistCount = rsDist.RecordCount
        rsDist.MoveFirst
        
    Else
        Exit Function
    End If
    
        While Not rsDist.EOF
            
            'Create directories
            strDirectoryName = mstrOutgoingDirectory & rsDist("CompMgr")
            If Dir(strDirectoryName & "\") = "" Then
                MakePath (strDirectoryName)
            End If
            
Debug.Print strDirectoryName
                         
            strEmp = "SELECT tbl_FolderPath.CompMgr, tbl_FolderPath.EEPlan, tbl_Global_Headcount.[Full Name], tbl_Global_Headcount.[Employee Number/Contingent Worker Number] AS EEID, tbl_Global_Headcount.[Org Name], tbl_Global_Headcount.Segment" & _
                    "FROM tbl_FolderPath INNER JOIN tbl_Global_Headcount ON tbl_FolderPath.EEID = tbl_Global_Headcount.[Employee Number/Contingent Worker Number]" & _
                    "GROUP BY tbl_FolderPath.CompMgr, tbl_FolderPath.EEPlan, tbl_Global_Headcount.[Full Name], tbl_Global_Headcount.[Employee Number/Contingent Worker Number], tbl_Global_Headcount.[Org Name], tbl_Global_Headcount.Segment, tbl_Global_Headcount.Year, Month([Month_Year])" & _
                    "HAVING (((tbl_Global_Headcount.Year) = Year(Now())) And ((Month([Month_Year])) = Month(Now())))" & _
                    "ORDER BY tbl_FolderPath.CompMgr, tbl_FolderPath.{Full Name]"
Debug.Print strEmp
        
                Set rsEmp = dbStatements.OpenRecordset(strEmp)
        
                While Not rsEmp.EOF
                
                'Update the report query
                'DoCmd.DeleteObject acQuery, "qry_rpt_statements"
                strReportFilter = "qry_YEStatements.[EEID] = '" & rsEmp("[EEID]") & "'"
                strReportPath = strDirectoryName & "\"
                

                               
                strReportSQL = "SELECT tbl_Global_Headcount.[Employee Number/Contingent Worker Number] AS EEID, tbl_Global_Headcount.[Full Name], tbl_Global_Headcount.[Org Name], tbl_Global_Headcount.Segment" & _
                                "FROM tbl_Global_Headcount" & _
                                "WHERE " & strReportFilter & _
                                "GROUP BY tbl_Global_Headcount.[Employee Number/Contingent Worker Number], tbl_Global_Headcount.[Full Name], tbl_Global_Headcount.[Org Name], tbl_Global_Headcount.Segment, tbl_Global_Headcount.Year, Month([Month_Year]), tbl_Global_Headcount.[System Person Type], tbl_Global_Headcount.[Termination Date]" & _
                                "HAVING (((tbl_Global_Headcount.[Full Name]) Is Not Null) And ((tbl_Global_Headcount.Year) = Year(Now())) And ((Month([Month_Year])) = Month(Now())) And ((tbl_Global_Headcount.[System Person Type]) = ""Actual EE"") And ((tbl_Global_Headcount.[Termination Date]) Is Null))" & _
                                "ORDER BY tbl_Global_Headcount.[Full Name]"
                               
                                
                strReportFileName = "2013" & "_Comp Stmt_" & "_" & rsEmp("[Full Name]") & ".pdf"
        
        Debug.Print strReportFileName
        
                'Create PDF Statements
                Set qryReport = dbStatements.CreateQueryDef("qry_YEStatements", strReportSQL)
                DoCmd.OutputTo acOutputReport, "rpt_YE_APR Statement", acFormatPDF, strReportPath & strReportFileName, False
                    
                    rsEmp.MoveNext
                Wend
            rsDist.MoveNext
        Wend

    

    rsEmp.Close
    Set rsEmp = Nothing
    rsDist.Close
    Set rsDist = Nothing
    
    DoCmd.SetWarnings True
    
    Call CheckForErrors
    Exit Function
    
Err_ExportAllStatements:
    Resume Next
End Function

 

[PHV]

At least your strDist SQL statement has syntax error (misplaced HAVING clause).

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886