Hello stackoverflow社区,
我使用宏将数据从一个工作表提取到另一个工作表,但我一直收到错误"微软访问数据库引擎无法找到对象' sheet1 $'& #34 ;.我确定引用的文件有Sheet1,路径是正确的。可能的问题是多个引用的文件是在同一个工作簿中创建的,之后又保存为单独的文件。因此,当我打开其中一个引用的文件时,它显示为Sheet2343(Sheet1),而我认为会产生问题 - 宏在工作簿中查找Sheet1,但只查找Sheet2343和因此返回错误消息。以下是我正在使用的代码。请问任何人,建议一个解决方法吗?
谢谢!
Sub Pull_Data()
Dim rsData As ADODB.Recordset
rsFile$ = ThisWorkbook.Path & "\" & Sheet1.Range("C1") & ".xlsx"
strConn$ = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & rsFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
rsSQL$ = "SELECT * FROM [Sheet1$]"
Set rsData = New ADODB.Recordset
rsData.Open rsSQL, strConn, , adOpenUnspecified, adLockUnspecified
Sheet1.Range("F4").CopyFromRecordset rsData
End Sub
答案 0 :(得分:1)
编辑:对于您的用例类似
Sub Pull_Data()
Dim rsData As ADODB.Recordset, sheetName
Dim rsFile As String, strConn, rsSQL
rsFile = ThisWorkbook.Path & "\" & Sheet1.Range("C1") & ".xlsx"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & rsFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
sheetName = GetSheetName(rsFile)
rsSQL = "SELECT * FROM [" & sheetName & "]"
Set rsData = New ADODB.Recordset
rsData.Open rsSQL, strConn, , adOpenUnspecified, adLockUnspecified
Sheet1.Range("F4").CopyFromRecordset rsData
End Sub
'return the worksheet name from a closed single-sheet Excel file
Function GetSheetName(fPath As String)
Dim cn As ADODB.Connection
Dim rsT As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & fPath & _
";Extended Properties=Excel 12.0;"
.CursorLocation = adUseClient
.Open
End With
Set rsT = cn.OpenSchema(adSchemaTables)
GetSheetName = rsT.Fields("TABLE_NAME").Value
rsT.Close: Set rsT = Nothing
cn.Close: Set cn = Nothing
End Function
以下是如何使用ADOX查询Excel工作簿的结构:
Sub Tester()
Dim cn As ADODB.Connection
Dim rsT As ADODB.Recordset
Dim intTblCnt As Integer, intTblFlds As Integer
Dim strTbl As String
Dim rsC As ADODB.Recordset
Dim intColCnt As Integer, intColFlds As Integer
Dim strCol As String
Dim t As Integer, c As Integer, f As Integer
Set cn = New ADODB.Connection
With cn
'edit: updated to work with .xlsx-format files
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & _
"\ADOXSource.xlsx;Extended Properties=Excel 12.0;"
.CursorLocation = adUseClient
.Open
End With
Set rsT = cn.OpenSchema(adSchemaTables)
intTblCnt = rsT.RecordCount
intTblFlds = rsT.Fields.Count
Debug.Print "Tables: " & intTblCnt
Debug.Print "--------------------"
For t = 1 To intTblCnt
strTbl = rsT.Fields("TABLE_NAME").Value
Debug.Print vbTab & "Table #" & t & ": " & strTbl
Debug.Print vbTab & "--------------------"
For f = 0 To intTblFlds - 1
Debug.Print vbTab & rsT.Fields(f).Name & _
vbTab & rsT.Fields(f).Value
Next
Debug.Print "--------------------"
Set rsC = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, strTbl, Empty))
intColCnt = rsC.RecordCount
intColFlds = rsC.Fields.Count
For c = 1 To intColCnt
strCol = rsC.Fields("COLUMN_NAME").Value
Debug.Print vbTab & vbTab & "Column #" & c & ": " & strCol
Debug.Print vbTab & vbTab & "--------------------"
For f = 0 To intColFlds - 1
Debug.Print vbTab & vbTab & rsC.Fields(f).Name & _
vbTab & rsC.Fields(f).Value
Next
Debug.Print vbTab & vbTab & "--------------------"
rsC.MoveNext
Next
rsC.Close
Debug.Print "--------------------"
rsT.MoveNext
Next
rsT.Close
cn.Close
End Sub
答案 1 :(得分:0)
我原来的问题是因为没有注意到某个字符串后面有空格。很简单,但花了我一些时间才弄明白。谢谢大家的宝贵意见!