Ms Access 2013 在 Windows 10 崩溃

Question

我有一个最初在 Ms Access 2010 中构建的数据库。部分 VBA 代码允许用户提取数据并保存到他们的机器上。这对早期版本使用 Ken Getz's code，对更高版本使用 Application.FileDialog()。

一个用户运行宁 64 位 Windows 10 安装了 Access 2013（32 位）。

当尝试运行这台机器上的代码时，Access 在没有任何错误消息的情况下崩溃并重新启动。

代码中检查了 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

Answer 1

几张支票。

检查参考资料 - 是否有任何标记为缺失？

您可能必须引用用户计算机上存在的 Microsoft Office 对象库 - 它是 64 位 Office 和 32 位 MS-Access 吗？

明显的问题 - 有编译错误吗？

EDIT - Update suggestions

您在需要 tagOpenFilename 结构的问题中调用 aht_apiGetOpenFileName，但在您的代码中显示您传递了多个参数

Answer 2

考虑使用 MS Access'FileDialog property but specify folder picker as dialog type。据我所知，这应该适用于任何 PC（32/64 位版本或 Office 2003-2016 版本）。您使用的有点过时的 link 涉及 Open/Save 对话框而不是 File/Folder 浏览器。

获得文件夹名称后，只需将 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

Ms Access 2013 在 Windows 10 崩溃

Ms Access 2013 crashing on Windows 10

ms-access

vba

ms-access-2013

windows-10