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

Question

我正在使用一些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。

这里有人有什么建议吗？

Answer 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:FolderNameDataBaseName.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:FolderNameDataBaseName.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

您可以从关闭的工作簿导入到访问吗???

GetDataFromClosedWorkbook "C:FolderNameWorkbookName.xls", "A1:B21", ActiveCell, False
GetDataFromClosedWorkbook "C:FolderNameWorkbookName.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

尝试这些示例并发布您的发现。