Access - 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中打开文件，我的access应用程序将不会导入它，抛出一个"table is in unexpected format"-error。如果我在excel中打开一次excel文件，然后将其关闭(不进行更改或保存)，则access将接受该文件。

我有从其他应用程序导出的其他97-2003 excel文件，这些应用程序工作良好，而不必在这里打开它们的once...am。

我尝试使用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:\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

Finally...can您浏览到一个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

尝试这些示例，并将您的发现发布回来。