我有一个MS Acccess 2013数据库,其中包含许多存储的查询和链接表到Excel电子表格。特别是我需要导出3个,我还需要创建备份。在我尝试自动化它时,我正在尝试使用VBA。
查询名称:
query1
query2
query3
数据库位于\\Reports\Run\Data
我希望第一个和第二个查询输出到\\Reports\Type1\
和\\Reports\Type1\[new sub-folder 1]
我想第三个查询导出到\\Reports\Type2\
and \\Reports\Type2\[new sub-folder 2]
其中一个链接的Excel电子表格(Table Name = Sheet1)
有1个单字段和1个单个条目,即ReportDate
。我希望[new sub-folder 1]
和[new sub-folder 2]
都是单日期条目。例如,如果2019-03-06是条目,则两个子文件夹都应称为“2019-03-06”。这些是我的备份和存储副本。
导出应覆盖\\Reports\Type1
和\\Reports\Type2
中的现有文件。
如果可能的话,能够使用ReportDate
为新子文件夹中的文件添加名称前缀也是很好的。
因此,最终的结果将是\\Reports\Type1\2019-03-06\20190306_query1.xlsx
,\\Reports\Type1\2019-03-06\20190306_query2.xlsx
和\\Reports\Type2\2019-03-06\20190306_query3.xlsx
作为例子。
我创建了一个宏来导出并将其转换为VBA作为起点。但是,我不确定如何动态命名和动态更改导出路径。
这是我使用的代码。我希望它可以帮助别人!
Option Compare Database
Option Explicit
Public Function ExportExcel()
'Declare all variables
Dim file As Object
Dim filepath As String
Dim fp_report1 As String
Dim fp_report2 As String
Dim fp_report1_date As String
Dim fp_report2_date As String
Dim data1 As String
Dim data2 As String
Dim data3 As String
Dim fp_report1_data1 As String
Dim fp_report1_data2 As String
Dim fp_report2_data3 As String
Dim fp_reportdate As String
Dim reportdate_backup As String
Dim reportdate As String
Dim data1_run As String
Dim data2_run As String
Dim data3_run As String
Dim myVar As Date
'Get report date from the ReportDate linked table
myVar = DLookup("ReportDate", "tbl_reportdate", "ReportDate")
' Get current path
filepath = CurrentProject.Path
'Destination for files for dashboard
fp_report1 = Left(filepath, 87) & "\report1\"
fp_report2 = Left(filepath, 87) & "\report2\"
'Location for backup with the date as the folder name
fp_report1_date = Left(filepath, 87) & "\report1\" & Format(myVar, "yyyy-mm-dd")
fp_report2_date = Left(filepath, 87) & "\report2\" & Format(myVar, "yyyy-mm-dd")
'Location of raw reports to backup and date file
fp_report1_data1 = Left(filepath, 97) & "report1_data1.xls"
fp_report1_data2 = Left(filepath, 97) & "report1_data2.xls"
fp_report2_data3 = Left(filepath, 97) & "report2_data3.xls"
fp_reportdate = Left(filepath, 97) & "ReportDate.xlsx"
'If the folders for the backup doesn't exist, create it, otherwise, do nothing.
If Dir(fp_report1_date, vbDirectory) = "" _
Then MkDir (fp_report1_date) _
Else _
If Dir(fp_report2_date, vbDirectory) = "" _
Then MkDir (fp_report2_date) _
Else _
'Exact path with file name for backup of processed data in the appropriate date folder
data1 = fp_report1_date & "\" & "data1.xlsx"
data2 = fp_report1_date & "\" & "data2.xlsx"
data3 = fp_report2_date & "\" & "data3.xlsx"
reportdate_backup = fp_report1_date & "\" & "ReportDate.xlsx"
'Exact path with file name for dashboard to automatically pull
data1_run = fp_report1 & "data1.xlsx"
data2_run = fp_report1 & "data2.xlsx"
data3_run = fp_report2 & "data3.xlsx"
reportdate = fp_report1 & "ReportDate.xlsx"
'Export queries into the date backup folder
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data1", data1
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data2", data2
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data3", data3
'Copy the files from the date backup folder into the path to be used by the dashboard. This includes the raw data in the reports and all the processed reports
FileCopy data1, data1_run
FileCopy data2, data2_run
FileCopy data3, data3_run
FileCopy fp_report1_data1, fp_report1_date & "\" & "report1_data1.xls"
FileCopy fp_report1_data2, fp_report1_date & "\" & "report1_data2.xls"
FileCopy fp_report2_data3, fp_report2_date & "\" & "report2_data3.xls"
FileCopy fp_reportdate, reportdate_backup
FileCopy reportdate_backup, reportdate
End Function