我有一个最初在MS Access 2010中构建的数据库。VBA代码的一部分允许用户提取数据并保存到其计算机中。这使用Ken Getz的较早版本的代码,而Application.FileDialog()
用于后期版本。
一个用户正在运行64位Windows 10,并安装了Access 2013(32位)。
试图在此计算机上运行代码时,访问崩溃而没有任何错误消息和重新启动。
64或32位版本的代码中有检查和VB版本(6或7)。
鉴于缺乏错误消息,我不确定如何对此进行故障排除或修复。
这是根据版本称为Ken Getz的代码的潜艇:
Dim queryYear As Variant
'Function to export data to location of users choice. Exports TWO queries to same workbook.
'Survey name is automatically detected from the control button used
'(must be changed to BaMN_ for example) as previous export only used one query.
'Year is derived from the combobox value on [Extract Data] form, null value defaults to all years.
Function exportData_Click()
'Checks VBA version. This function will only work on 7+
#If VBA7 Then
'Code is running in the new VBA7 editor
'Declare Variables used by both 32 and 64 bit versions
Dim strSaveFileName As String 'both
Dim The_Year As Variant 'both
Dim ctlCurrentControl As Control 'both
Dim surveyName As String 'both
Dim allData As String 'both
Dim effort As String 'both
Dim fileYear As String 'both
'Get the name of the control button clicked (corresponds to query name to be run)
Set ctlCurrentControl = Screen.ActiveControl
surveyName = ctlCurrentControl.Name
allData = surveyName & "AllData"
effort = surveyName & "Effort_Export"
'Get combobox value and assign relavent values to The_Year
The_Year = Forms![Extract Data]!Extract_Year.value
'Change the year from a variant to what we need in the SQL
If The_Year Like "20*" Then
The_Year = CInt(The_Year)
fileYear = The_Year
Else:
The_Year = "*"
fileYear = "All"
End If
'Set queryYear variable
setYear (The_Year)
'If block to deal with both 32 and 64 bit versions.
#If Win64 Then
'Code is running in 64-bit version of Microsoft Office
MsgBox ("Running 64 bit version")
'Declare 64 bit only variables
Dim f As FileDialog
'Open the Save as Dialog to choose location of query save
Set f = Application.FileDialog(msoFileDialogSaveAs)
f.AllowMultiSelect = False
f.ButtonName = "Save"
f.Title = "Save As"
strSaveFileName = surveyName & fileYear & "_output.xlsx"
f.InitialFileName = strSaveFileName
f.Show
'End of 64 bit code
#Else
'Code is running in 32-bit version of Microsoft Office
MsgBox ("Running 32 bit version")
'Declare
Dim strFilter As String '32
'Open the Save as Dialog to choose location of query save for 32 bit
strFilter = ahtAddFilterItem("Excel Files (*.xlsx)", "*.xlsx")
strSaveFileName = ahtCommonFileOpenSave( _
openFile:=False, _
Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
#End If
'Export functions for different survey cases
If surveyName Like "*O*_" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, allData, strSaveFileName
ElseIf surveyName Like "*DA_" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Occ_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Trees_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "RepTree_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Habitat_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "TPole_export", strSaveFileName
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, allData, strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, effort, strSaveFileName
End If
#Else
'Code is running in VBA version 6 or earlier
MsgBox ("Only available on MS Access 2007 and above")
#End If
End Function
'Function to set queryYear used in data extraction queries
Public Function setYear(The_Year As Variant)
queryYear = The_Year
End Function
'Function to get queryYear used in data extraction queries
Function getYear()
getYear = queryYear
End Function
考虑使用MS Access'Filedialog属性,但将文件夹拾取器指定为对话框类型。据我所知,这应该符合任何PC(32/64位版本或Office 2003-2016版本)。您使用的一些日期链接涉及打开/保存对话框,而不是文件/文件夹浏览器。
获取文件夹名称后,只需与Excel文件的基本名称,有条件在导出类型上: surveyName , alldata 或努力
Function exportData_Click()
' Declare Variables
Dim strSaveFileName As String
Dim The_Year As Variant
Dim ctlCurrentControl As Control
Dim surveyName As String, allData As String, effort As String
Dim fileYear As String
Dim fd As Object
Const msoFileDialogFolderPicker = 4
Dim strFolderPath
' Get the name of the control button clicked (corresponds to query name to be run)
Set ctlCurrentControl = Screen.ActiveControl
surveyName = ctlCurrentControl.Name
allData = surveyName & "AllData"
effort = surveyName & "Effort_Export"
' Get combobox value and assign relavent values to The_Year
The_Year = Forms![Extract Data]!Extract_Year.Value
' Change the year from a variant to what we need in the SQL
If The_Year Like "20*" Then
The_Year = CInt(The_Year)
fileYear = The_Year
Else:
The_Year = "*"
fileYear = "All"
End If
' Set queryYear variable
setYear (The_Year)
' Folder Pick Dialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Browse for folder to export queries"
.AllowMultiSelect = False
.Filters.Clear
If .Show = -1 Then
strFolderPath = .SelectedItems(1)
Else
'The user pressed Cancel.
MsgBox "No folder Selected", vbExclamation
strFolderPath = Null
Set fd = Nothing
Exit Function
End If
End With
Set fd = Nothing
' Export functions for different survey cases
If surveyName Like "*O*_" Then
strSaveFileName = strFolderPath & "" & allData & ".xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, allData, strSaveFileName
ElseIf surveyName Like "*DA_" Then
strSaveFileName = strFolderPath & "" & surveyName & ".xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Occ_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Trees_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "RepTree_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "Habitat_export", strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, surveyName & "TPole_export", strSaveFileName
Else
strSaveFileName = strFolderPath & "" & allData & ".xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, allData, strSaveFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, effort, strSaveFileName
End If
End Function
几个检查。
检查参考 - 有没有标记为缺少的?
您可能必须参考用户计算机上存在的Microsoft Office对象库 - 是64位Office,带有32位MS -ACCESS?
明显的问题 - 任何编译错误?
编辑 - 更新建议
您在需要tagOpenFilename
结构的问题中调用aht_apiGetOpenFileName
,但是在您的代码中,您正在显示您传递多个参数