DoCmd.OutputTo question?

[nidgep]

hi

I have an access database which is used to run automated reports from a scheduled task using a macro to call vba code.

The vba code uses the

[COLOR=blue]DoCmd.OpenReport[/color]

and also uses

[COLOR=blue]DoCmd.OutPutTo.[/color]

Recently the DoCmd.OutputTo has been failing to create the reports at the specified location and yet generates no errors even when stepping through the code line by line.
Each of the reports are opened in turn and displayed on screen for a while before writing to the output file as an RTF.
I have checked all permission etc. The same result happens on my pc as it does when automated through the scheduled task on the server.
Does anyone know why this is happening?

Regards

 

[dhookom]

Can you explain "failing to create the reports at the specified location"? What location are the reports printing to and where do you expect them to print? Can we see more of your code?

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[nidgep]

hi
The reports are not being printed in the sense that they are being sent to a printer device, but there are supposed to be 'sent' to a file instead.

The code recieves a report name from the macro call.

The report name is used to decipher which report to run and to build an SQL Where clause to use in the DoCmd.OpenReport call.

The report is being opened and briefly displayed but then doesn't save as expected. If I change the parameter which causes the associated application to load (in this case Word) then the report loads fine - and even has the expected filename but once word is closed the file does not exist at the location provided (which is a valid location with correct permissions etc).

After much trial and error - the damn thing started to work again!

The function code is below if it helps.

[COLOR=blue]
Public Function autoRunBenefitsReport(ByVal strReportName As String)

    On Error GoTo err_handler
    
    'used to catch the return value from the log writing
    Dim lngRetVal As Long
    'used to hold an error messages returned from the log writing
    Dim strErrorMsg As String
    lngRetVal = -1
    strErrorMsg = ""
    
    
    'run the AUTO_COMPLETED_DOCUMENTS_REPORT
    'and the AUTO_PENDING_DOCUMENTS_REPORT
    If Len(strReportName) = 0 Then
        lngRetVal = modGeneralFuncs.WriteToLog("Missing reportname, exiting....", strErrorMsg)
        Exit Function
    End If
    
           
    'we need to have the name of those involved
    'the start and end date
    'the file system - fixed to HB for the auto reports
    'mail_status will depend on which report is being run
    
    Dim strWhere As String
    Dim strMailStatus As String
    Dim strStartDate As String
    Dim strEndDate As String
    strStartDate = CStr(modDateFuncs.getCurrentDate)
    strEndDate = CStr(modDateFuncs.getTomorrowsDate)
    
    Dim arrUsers(15) As String ' =  array containing users -see below - change as users are added / deleted
    Const FILE_SYSTEM As String = "HB"
    Dim intUser As Integer
    
    
    Dim strFilePath As String
    Dim strNewFolder As String
    'LIVE output path for the reports
    strFilePath = "\\server\path\Reports\"

    If modGeneralFuncs.createOPFolder(strFilePath, strStartDate, strNewFolder, strErrorMsg) = 0 Then
        'add the folder to the path
        strFilePath = strFilePath & strNewFolder & "\"
    Else
        'folder with the name that represents the Starting Date
        modGeneralFuncs.WriteToLog "Request for [" & strReportName & "]", strErrorMsg
        Exit Function
    End If
    
    
    'will hold an abbreviated report name
    Dim strText As String
    'will hold the completed string to indictate the path and file name
    Dim strFileNameAndPath As String
    
    
    Select Case LCase(strReportName)
        Case "auto_completed_documents_report"
            strMailStatus = "C"
            strText = "COMP_"
            lngRetVal = modGeneralFuncs.WriteToLog("Received request for " & strReportName, strErrorMsg)
        Case "auto_pending_documents_report"
            strMailStatus = "P"
            strText = "PEND_"
            lngRetVal = modGeneralFuncs.WriteToLog("Received request for " & strReportName, strErrorMsg)
        Case Else
            lngRetVal = modGeneralFuncs.WriteToLog("Report name specified [" & strReportName & "] is unknown." & vbCrLf & _
                        "Please check your input or the input query and try again.", strErrorMsg)
            Exit Function
    End Select
    
            
    arrUsers(0) = "A"
    arrUsers(1) = "B"
    arrUsers(2) = "E"
    arrUsers(3) = "J"
    arrUsers(4) = "I"
    arrUsers(5) = "L"
    arrUsers(6) = "M"
    arrUsers(7) = "P"
    arrUsers(8) = "S"
    arrUsers(9) = "U"
    arrUsers(10) = "K"
    arrUsers(11) = "EH"
    arrUsers(12) = "b8"
    arrUsers(13) = "B3"
    arrUsers(14) = "b4"
    arrUsers(15) = "SPC"

    
    For intUser = 0 To UBound(arrUsers)
    
        If LCase(strReportName) = "auto_completed_documents_report" Then
            strWhere = "[AUTO_COMPLETE]![USER_ID] = '" & arrUsers(intUser) & "' " & _
                            " AND " & _
                            "[AUTO_COMPLETE]![MAIL_STATUS] = '" & strMailStatus & "' " & _
                            " AND " & _
                            " [AUTO_COMPLETE]![DATE_COMP] BETWEEN " & _
                            "DateValue('" & strStartDate & "') AND DateValue('" & strEndDate & "') " & _
                            " AND " & _
                            " [AUTO_COMPLETE]![FILE_SYSTEM] = '" & FILE_SYSTEM & "'"
                            
        ElseIf LCase(strReportName) = "auto_pending_documents_report" Then
            strWhere = "[AUTO_PENDING]![USER_ID] = '" & arrUsers(intUser) & "' " & _
                            " AND " & _
                            "[AUTO_PENDING]![MAIL_STATUS] = '" & strMailStatus & "' " & _
                            " AND " & _
                            " [AUTO_PENDING]![DATE_PEND] BETWEEN " & _
                            "DateValue('" & strStartDate & "') AND DateValue('" & strEndDate & "') " & _
                            " AND " & _
                            " [AUTO_PENDING]![FILE_SYSTEM] = '" & FILE_SYSTEM & "'"
                            
        Else
            '?cant build the criteria so exit with message
            lngRetVal = modGeneralFuncs.WriteToLog("Cannot build the SQL WHERE criteria. Report [" & strReportName & "] is unknown." & vbCrLf & _
                        "Please check your input or the input query and try again.", strErrorMsg)
            
            Exit Function
        End If
        
        lngRetVal = modGeneralFuncs.WriteToLog("Processing WHERE clause :" & vbCrLf & strWhere & vbCrLf & _
                                                                "For " & arrUsers(intUser), strErrorMsg)
        

         'add the file name to the output path string
        strFileNameAndPath = strFilePath & strText _
                                        & arrUsers(intUser) _
                                        & "_" & Replace(strStartDate, "/", "_") & ".rtf"
                
        'acViewNormal will cause the report to print immediately
        'acViewPreview as the name implies show on screen - 2
        lngRetVal = modGeneralFuncs.WriteToLog("Opening report...", strErrorMsg)
        DoCmd.OpenReport strReportName, acViewPreview, , strWhere
        
        lngRetVal = modGeneralFuncs.WriteToLog("Creating report..." & vbCrLf & _
                                                                strFileNameAndPath, strErrorMsg)
        DoCmd.OutputTo acOutputReport, strReportName, acFormatRTF, strFileNameAndPath, 0 '0=false & -1 = true launch application
         
        'introduce a pause between each print request
        'before processing the next report
        Pause (30)
        
        lngRetVal = modGeneralFuncs.WriteToLog("Closing report...", strErrorMsg)
        'now close the report and continue
        DoCmd.Close acReport, strReportName, acSaveNo
        
        'add another few seconds before beginning the process again
        Pause (5)
    
    Next
exit_function:
    lngRetVal = modGeneralFuncs.WriteToLog("Exiting function...", strErrorMsg)
    Exit Function

err_handler:
    lngRetVal = modGeneralFuncs.WriteToLog("An unexpected error has occurred." & vbCrLf & _
                "Error : " & Err.Number & " - " & Err.Description & vbCrLf & _
                "Source : " & Err.Source, strErrorMsg)
                
    Resume exit_function

End Function

[/color]

thanks for your help

regards