MS Access 2013在Windows 10上崩溃



我有一个最初在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,但是在您的代码中,您正在显示您传递多个参数

最新更新