0
votes

I have created a database in access that stores data about my work.

I have also created a report that is linked to a table in this DB that is run by a Macro which creates a file (exports) through VBA onto my desktop. Right now I am trying to change this so that the file will check the directory (i.e desktop), create a year folder (i.e 2020) if it not created, then check inside that folder for the month name (i.e January) if this is not created and then a day folder etc for every month. Right now this works fine. But I am struggling to get the file to output to this location when it has completed these checks. Just not sure how to word it while keeping the DoCmd.OutputTo etc... Heres some code to show you what I mean:

Function Reportmacro()
On Error GoTo Reportmacro_Err
   
    ' Check for year folder and create if needed
    If Len(Dir("H:TEST\" & Year(Date), vbDirectory)) = 0 Then
        MkDir "H:TEST\" & Year(Date)
    End If

     ' Check for month folder and create if needed
    If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
        MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False)
    End If
    
    ' Check for day folder and create if needed
    If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
        MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date)
        DoCmd.OutputTo acOutputReport, "Changeover Car Report", "PDFFormat(*.pdf)", "CCReport" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".pdf", False, "", , acExportQualityPrint
    End If
    
    
Reportmacro_Exit:
    Exit Function

Reportmacro_Err:
    MsgBox Error$
    Resume Reportmacro_Exit

End Function

At the moment it is going to a "TEST" folder but same logic applies.

1
You need to add the path with the filename, in DoCmd.OutputTo - jbud

1 Answers

3
votes

try this, code remains the same, only added the folder path to the file name:

Function Reportmacro()
On Error GoTo Reportmacro_Err

    Dim fPath as String
   
    ' Check for year folder and create if needed
    If Len(Dir("H:TEST\" & Year(Date), vbDirectory)) = 0 Then
        MkDir "H:TEST\" & Year(Date)
    End If

     ' Check for month folder and create if needed
    If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
        MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False)
    End If
    
    ' Check for day folder and create if needed
    fPath = "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date)
    If Len(Dir(fPath, vbDirectory)) = 0 Then
        MkDir fPath
        DoCmd.OutputTo acOutputReport, "Changeover Car Report", "PDFFormat(*.pdf)", fPath & "\" & "CCReport" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".pdf", False, "", , acExportQualityPrint
    End If
    
    
Reportmacro_Exit:
    Exit Function

Reportmacro_Err:
    MsgBox Error$
    Resume Reportmacro_Exit

End Function

check the docs: https://docs.microsoft.com/en-us/office/vba/api/access.docmd.outputto