如何使用以下 VBA 代码在生成“另存为”对话框并导出 Access 查询的表单上创建命令按钮？

Posted 2023-04-19

【中文标题】如何使用以下 VBA 代码在生成“另存为”对话框并导出 Access 查询的表单上创建命令按钮？

【英文标题】：How do I use the following VBA code to create a command button on my form that produces "Save As" Dialog Box and exports Access queries?

【发布时间】：2014-03-03 17:55:53

【问题描述】：

这个问题与以下两个帖子有关：

How to run a query when a button is pressed and export results to Excel File

“Save as…” dialog box in MSAccess vba: how?

我目前有一个参数化查询（我们称之为“qryExport”），它从表单上的某些控件中获取值（我们称之为“Form A”）。从上述链接中，我了解到我可以将以下代码行用于“Form A”命令按钮的“单击”事件，该事件可以将“qryExport”作为 Excel 文件导出到固定文件路径位置。

DoCmd.TransferSpreadsheet acExport, , "qryExport", "C:\yourPath\exportedReport.xlsm", True

问题：

但是，我需要为“Form A”生成一个命令按钮，当用户单击它时执行以下操作：

1) 提示用户命名即将导出的文件。

2) 允许用户指定他们希望在他们的机器上保存导出的“qryExport”对象的位置。

3) 允许用户选择他们想要导出“qryExport”的文件类型（例如 Excel、XML、Txt 等）。

4) 用户选择文件路径指定、文件名和所需文件类型后执行导出操作。

我会将我的表单分发给多个用户（他们在不同的工作站工作），这需要我的命令按钮满足上述要求。

我考虑过一种可能的解决方案是在用户单击命令按钮时添加“另存为”提示。它会要求用户指定文件路径，选择他们希望在工作站中将文件保存为何种文件格式（Excel、XML、Txt 等），并允许他们为新文件命名。

我发现 VBA 代码允许命令按钮生成“另存为”窗口（值得注意的是，它只为用户提供将文件另存为 Excel 文件的选项）（请参阅链接下方的代码）：

VBA Save As origin

Option Compare Database
Private mstrFileName As String
Private mblnStatus As Boolean
'Declare needed functions
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

'Declare OPENFILENAME custom Type
Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

'Function needed to call the "Save As" dialog
Public Function SaveFileDialog(lngFormHwnd As Long, _
lngAppInstance As Long, strInitDir As String, _
strFileFilter As String) As Long

Dim SaveFile As OPENFILENAME
Dim X As Long

If IsMissing(strFileName) Then strFileName = ""

With SaveFile
 .lStructSize = Len(SaveFile)
 .hwndOwner = lngFormHwnd
 .hInstance = lngAppInstance
 .lpstrFilter = strFileFilter
 .nFilterIndex = 1
 .lpstrFile = String(257, 0)
 'Use for a Default File SaveAs Name - [UD]
 '.lpstrFile = "testfile.txt" & String(257 - Len("testfile.txt"), 0)
 .nMaxFile = Len(SaveFile.lpstrFile) - 1
 .lpstrFileTitle = SaveFile.lpstrFile
 .nMaxFileTitle = SaveFile.nMaxFile
 .lpstrInitialDir = strInitDir
 .lpstrTitle = "Enter a Filename to Save As"        '[UD]
 .Flags = 0
 .lpstrDefExt = ".xls"   'Sets default file extension to Excel,
                         'in case user does not type it - [UD]
End With

X = GetSaveFileName(SaveFile)

If X = 0 Then
  mstrFileName = "none"
  mblnStatus = False
Else
  mstrFileName = Trim(SaveFile.lpstrFile)
  mblnStatus = True
End If
End Function
Public Property Let GetName(strName As String)
  mstrFileName = strName
End Property
Public Property Get GetName() As String
  GetName = mstrFileName
End Property
Public Property Let GetStatus(blnStatus As Boolean)
  mblnStatus = blnStatus
End Property
Public Property Get GetStatus() As Boolean
  GetStatus = mblnStatus
End Property

但是，该代码并不能满足我的所有需求。我不知道如何使用组合所有这些代码在我的表单上生成所需的命令按钮。

一如既往，感谢您的宝贵时间。

请注意：我使用的是 Access 2010

【参考方案1】：

您是否查看过FileDialog 选项的功能？你可以用这个来做你提到的一切；不需要 WinAPI 的东西。真正的问题是DoCmd.TransferSpreadsheet 命令只会生成一个Excel 文件。

如果你想创建其他文件类型，你需要：

创建FileDialog 对象set fd = Application.FileDialog(msoFileDialogFilePicker) 设置FileDialog 对象 从对象fd.Filters.Clear 中清除以前的扩展 提供可用的扩展fd.Filters.Add "Query Output", "*.xls; *.txt; *.xml" 在这种情况下关闭多选fd.AllowMultiSelect = False 提供默认文件名fd.InitialFilename = "<desired start path>\<desired filename>.<desired extension>" .Show它给用户并返回fd.Show的结果 If fd.Show Then（他们没有点击取消或关闭对话框）（如果他们按下保存则显示 = true） 查看他们为后续步骤选择的文件名的扩展名 If Instr(fd.SelectedItems(0), ".xls") > 0 Then 'Do the xls stuff If Instr(fd.SelectedItems(0), ".xml") > 0 Then 'Do the text stuff Else 'Do the xml stuff 将查询的输出解析为用户选择的格式 通过解析查询结果的内容创建文本文件或XML。 使用TransferSpreadsheet 命令创建 XLS。

该命令不仅会创建您想要的文件类型。你需要控制它。 Read this link for more info for 2013 and 2010. Read this link for better descriptions of the properties of the FileDialog object

要使这部分命令按钮单击事件，只需在窗体的命令按钮的单击事件过程中编写代码即可。