Question

我有一个MS Acccess 2013数据库，其中包含许多存储的查询以及与Excel电子表格的链接表。我特别需要导出3个文件，还需要创建备份。为了实现自动化，我尝试使用VBA。

查询名称：

query1
query2
query3

该数据库位于\\Reports\Run\Data中我想将第一个查询和第二个查询都导出到\\Reports\Type1\和\\Reports\Type1\[new sub-folder 1] 我希望第三个查询导出到\\Reports\Type2\和\\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作为起点。但是，我不确定如何进行动态命名和动态更改导出路径。

Answer 1

这是我使用的代码。我希望它可以帮助其他人！

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

MS Access VBA和要导出的宏

1 个答案: