Question

我正在尝试通过TransferText将数据导入我的MS Access项目，但是收到错误＃3051：“Microsoft Access数据库引擎无法打开或写入文件”。它已由其他用户独占打开，或者您需要具有查看和写入其数据的权限。“

我很奇怪，错误消息中给出的文件名是空白的。我已检查并重新检查文件名，甚至在TransferText调用之前执行检查“If Not fso.FileExists（file_name）Then ... End If”。

我还检查并重新检查了表名和文件权限。在TransferText调用之前，表已成功清空，因此我知道它有效。该文件位于相对于桌面上文件夹中的Access数据库文件的子文件夹中。我没有为任何文件夹或文件设置或取消设置任何权限。

到目前为止，我一直在使用DoCmd.TransferSpreadsheet导入从基于Web的工具下载的数据，但我发现Excel误将一些字母数字代码误解为科学格式的数字，例如1E100将变为1E + 100 Excel文件，因此在访问Access数据库之前数据已损坏。这些代码以不可纠正的方式被破坏，因此我无法在导入后修改数据。我发现我可以将Web工具中的数据保存为CSV文件而不是Excel文件;这导致我尝试使用DoCmd.TransferText。

以下是我正在使用的代码：

Private Function ImportExcel( _
 ByVal file_name As String, _
 ByVal table_name As String _
) As Integer
    On Error GoTo Error

    Dim fso As FileSystemObject, folder_name As String

    Dim xl_book As Excel.Workbook
    Dim xl_sheet As Excel.Worksheet

    Dim i As Integer

' suppress excel's file-not-found popup
    Set fso = New FileSystemObject
    If Not fso.FileExists(file_name) Then
        ImportExcel = -1
        GoTo Finish
    End If

' gets a workbook from a global application object
    Set xl_book = Util.GetExcelWorkbook( _
        file_name:=file_name, _
        visible:=False, _
        use_cache:=True _
    )

    If xl_book Is Nothing Then
        ImportExcel = -1
        GoTo Finish
    End If

' always use the first worksheet
    Set xl_sheet = xl_book.Sheets(1)

' fake the first record to force columns types
    xl_sheet.range("A2").EntireRow.Insert
    For i = 1 To xl_sheet.UsedRange.columns.count
        xl_sheet.Cells(2, i) = "test"
    Next i

' make sure the table is closed
    DoCmd.Close _
        ObjectType:=acTable, _
        ObjectName:=table_name, _
        Save:=acSaveNo

' link to file
    DoCmd.SetWarnings False
    If ".csv" = Right(file_name, 4) Then
' empty table
        DoCmd.RunSQL "DELETE * FROM " & table_name, True
' import data
        Debug.Print table_name
        Debug.Print file_name
        DoCmd.TransferText _
            TransferType:=acImportDelim, _
            SpecificationName:=table_name & " Import Spec", _
            TableName:=table_name, _
            FileName:=file_name, _
            HasFieldNames:=True
    Else
' delete table
        On Error Resume Next
        DoCmd.DeleteObject _
            ObjectType:=acTable, _
            ObjectName:=table_name
        If 0 <> Err.Number Then
            Resume Next
        End If
        On Error GoTo Error
' import data
        DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            TableName:=table_name, _
            FileName:=file_name, _
            HasFieldNames:=True, _
            range:=xl_sheet.NAME() & "!" & _
                xl_sheet.range( _
                    xl_sheet.Cells(1, 1), _
                    xl_sheet.Cells( _
                        xl_sheet.UsedRange.rows.count, _
                        xl_sheet.UsedRange.columns.count _
                    ) _
                ).Address(RowAbsolute:=False, ColumnAbsolute:=False), _
            SpreadsheetType:=acSpreadsheetTypeExcel9
    End If
    DoCmd.SetWarnings True

Finish:
    Set xl_sheet = Nothing
    If Not xl_book Is Nothing Then
        xl_book.Close SaveChanges:=False
    End If
    Set xl_book = Nothing

    Set fso = Nothing

    Exit Function

Error:    
    Resume Finish
End Function

在DoCmd.TransferText调用之前的两个Debug.Print调用打印完全符合预期。

DoCmd.TransferText错误3051

0 个答案: