【发布时间】: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 文件的选项)(请参阅链接下方的代码):
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
【问题讨论】:
标签: xml database vba ms-access export-to-excel