访问 - VBA - 无法导入新的 excel 文件 - 但打开一次后可以

Posted 2023-04-19

【中文标题】访问 - VBA - 无法导入新的 excel 文件 - 但打开一次后可以

【英文标题】：Access - VBA - Cannot import new excel file - but can after opening it once

【发布时间】：2017-04-10 21:45:27

【问题描述】：

我正在使用一些 VBA 将 Excel 文件导入 Access。

Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, tableName, fileName, True, "A5:H5000"
End Sub

还有：

Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim Item As Variant

Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select your excel file"
diag.Filters.Clear
diag.Filters.Add "Excel files", "*.xls, *.xlsx"

If diag.Show Then
    For Each Item In diag.SelectedItems
       Me.txtFileName = Item
    Next
End If


End Sub

问题如下：

我从我们在这里运行的一个应用程序中提取了一个 excel 文件。这是一个 97-2003 .xls 文件。

如果我没有先在 excel 中打开文件，我的访问应用程序将不会导入它，从而引发“表格格式意外”-错误。如果我在 excel 本身中打开 excel 文件一次并关闭它（不更改或保存它），则访问将接受该文件。

我还有其他从其他应用程序导出的 97-2003 excel 文件，这些文件可以正常工作而无需打开一次......我在这里不知所措。

我尝试使用 acSpreadsheetTypeExcel8 和 9 代替。没运气。 excel文件也不是变相的.htm。

这里有人有什么建议吗？

【问题讨论】：

(a) 在您“在 excel 中打开一次 excel 文件并关闭它（不更改或保存它）”之后，使用 Windows 资源管理器查看文件时，文件的上次更新日期/时间是否会发生变化? (b) 如果您在 Excel 中打开它并尝试导入它之间重新启动计算机，它仍然可以工作还是会像没有打开它一样崩溃？

好的，我都试过了，结果如下：a) 当我打开 excel 文件时，我可以在资源管理器中看到它的时间戳更改为当前日期/时间。但是，当我关闭它时，时间戳会返回到创建日期/时间。之后我可以毫无问题地导入文件。 b）我先在excel中打开文件后重新启动，它可以让我毫无问题地导入文件。希望这能让您对这里可能发生的事情有所了解。

我已改用 CSV，我的应用无需先打开即可接受这些文件。因此，虽然我的问题已“解决”，但这个问题对我来说仍然是一个谜，如果有人对可能导致此问题的原因有任何想法，我很乐意听到。

好吧，我的两个理论关于 (a) 尽管没有保存文件，但对文件进行了物理更改，或者 (b) 一些信息保留在内存中识别文件，这两种理论都被证明是不可能的。所以我很难过。

【参考方案1】：

您可以使用 ADO 从 Excel 导出到 Access 吗？？？

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

你能用 DAO 做同样的事情吗？？？

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

您可以从已关闭的工作簿中导入 Access 吗？？？

GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range ("B3"), True

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
    TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
    dbConnectionString = "DRIVER=Microsoft Excel Driver (*.xls);" & _
        "ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.Offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
        vbExclamation, "Get data from closed workbook"
End Sub

最后...您可以浏览到 Excel 文件并从该文件中导入数据吗？？？

Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

strBrowseMsg = "Select the EXCEL file:"

' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
strInitialDirectory = "C:\MyFolder\"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")

strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
      Filter:=strFilter, OpenFile:=False, _
      DialogTitle:=strBrowseMsg, _
      Flags:=ahtOFN_HIDEREADONLY)

If strPathFile = "" Then
      MsgBox "No file was selected.", vbOK, "No Selection"
      Exit Sub
End If

' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
      strTable, strPathFile, blnHasFieldNames

' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile

试试这些例子，然后把你的发现发回来。

【讨论】：

您好，感谢您的建议。我现在正在检查是否可以将表导入为 csv 文件，因为我的应用程序中也有该导出选项。如果失败了，我会检查你的方法并报告。

我已改用 CSV，我的应用无需先打开即可接受这些文件。因此，虽然我的问题已“解决”，但这个问题对我来说仍然是个谜，如果有人对可能导致此问题的原因有任何想法，我很乐意听到。