我已经在Access中创建了一个数据库，用于存储有关我的工作的数据。
我还创建了一个报告，该报告链接到该数据库中的一个表，该表由宏运行，该宏通过VBA在我的桌面上创建文件（导出）。现在，我正在尝试更改它，以便该文件将检查目录（即桌面），如果未创建则创建年份文件夹（即2020），然后在该文件夹中检查月份名称（即一月）是否为没有创建，然后每月的日文件夹等。现在，这很好。但是，在完成这些检查后，我很难使文件输出到此位置。只是不确定如何在保持DoCmd.OutputTo等字眼的情况下...这里有一些代码向您展示我的意思：
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
目前，它将进入“ TEST”文件夹，但适用相同的逻辑。
尝试此操作，代码保持不变，仅将文件夹路径添加到文件名：
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
检查文档：https : //docs.microsoft.com/zh-cn/office/vba/api/access.docmd.outputto
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句