VBA sheet1 $错误消息

时间:2016-06-16 21:43:32

标签: sql excel vba excel-vba

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

2 个答案:

答案 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)

我原来的问题是因为没有注意到某个字符串后面有空格。很简单,但花了我一些时间才弄明白。谢谢大家的宝贵意见!