我正在嘗試使用多張作業表匯入多個 Excel 檔案。

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

strFileName = "C:\SomeFile\File.xlsx"

Set objWorkbook = objExcel.Workbooks.Open(strFileName)
Set colWorksheets = objWorkbook.Worksheets

For Each objWorksheet in colWorksheets 
    Set objRange = objWorksheet.UsedRange 
    strWorksheetName = objWorksheet.Name & "!" & objRange.Address(False, False) 
    objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "Vulnerability", strFileName, True, strWorksheetName
Next

我的范圍有問題。變數 strWorksheetName = "BE900!A1:L1634"。

我收到運行時錯誤“3011”。這 ”！” 被 "$" 替換，因此找不到作業表。

有任何想法嗎？

我所有的代碼

Public Function ImportFiles() Dim strFolder As String Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim strFile As String Dim strTable As String Dim strExtension As String Dim lngFileType As Long Dim strSQL As String Dim strFullFileName As String Dim varPieces As Variant

With Application.FileDialog(3) ' msoFileDialogFolderPicker
.AllowMultiSelect = True
.Title = "Please select one or more files"
.Initialfilename = "*.xls*"

If .Show Then
    strFullFileName = .SelectedItems(1)
Else
    MsgBox "No folder specified!", vbCritical
    Exit Function
End If
End With

strFile = Dir(strFolder)

Set db = CurrentDb()

strFile = Dir(strFolder & "*.xls*")
Do While Len(strFile) > 0
strTable = DetermineTable(strFile)

strSQL = "UPDATE [" & strTable & "] SET FileName=[pFileName]" & vbCrLf & _
"WHERE FileName Is Null OR FileName='';"
Set qdf = db.CreateQueryDef(vbNullString, strSQL)

varPieces = Split(strFile, ".")
strExtension = varPieces(UBound(varPieces))
Select Case strExtension
    Case "xls"
        lngFileType = acSpreadsheetTypeExcel9
    Case "xlsx", "xlsm"
        lngFileType = acSpreadsheetTypeExcel12Xml
    Case "xlsb"
        lngFileType = acSpreadsheetTypeExcel12
End Select

Set objexcel = CreateObject("Excel.Application")
Set objworkbook = objexcel.Workbooks.Open(strFullFileName)
Set colworksheets = objworkbook.Worksheets

For Each objWorksheet In colworksheets
    Set objRange = objWorksheet.UsedRange
    **strWorksheetName = objWorksheet.Name & "!" & objRange.Address(False, False)**
    'strWorksheetName = objRange.Address(0, 0, external:=True)
        DoCmd.TransferSpreadsheet _
                TransferType:=acImport, _
                SpreadsheetType:=lngFileType, _
                tableName:=strTable, _
                FileName:=strFile, _
                HasFieldNames:=False, _
                **Range:=CStr(strWorksheetName)**
Next

colworksheets.Close
colworksheets = Nothing
objworkbook.Close
objworkbook = Nothing
objexcel.Close
objexcel = Nothing

Set db = CurrentDb()
Set tdf = db.TableDefs(strTable)

'Add the field to the table.
If FieldExistsInTable(strTable, "FileName") = True Then
    'Do nothing
Else
    tdf.Fields.Append tdf.CreateField("FileName", dbText, 255)
    'tdf.fields.append tdf.createField("SheetName", dbText, 255)
End If

'Supply the parameter value for the UPDATE and execute it ...
qdf.Parameters("pFileName").Value = strFile
qdf.Execute 'dbFailOnError

'Move to the next file
strFile = Dir
 Loop

Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
'rstTable.Close
Set rstTable = Nothing

End Function

uj5u.com熱心網友回復：

宏沒有錯誤，在我的電腦上運行良好。

您可以嘗試重啟電腦。

我這沒有幫助，您可以定義strWorksheetName2，替換$在strWorksheetName用!。然后給它訪問物件。

uj5u.com熱心網友回復：

在新資料庫中從頭開始重新構建代碼，現在它可以作業了。感謝您的幫助。

標籤：擅长 vba 谷歌表格

上一篇：不在Z列之后復制資料

下一篇：打開csv檔案時禁用excel將字串轉換為日期