Question

我正在尝试编写连接字符串和SQL脚本以在Excel中运行查询以从另一个Excel工作簿中提取数据。这就是我目前所拥有的：

Sub Test()

   Dim conn As ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim sConnString As String
   Dim sql As String

   ' Create the connection string.
   sConnString = "provider=Microsoft.Jet.OLEDB.4.0;data source=" & _
              "C:\Users\dblois\Desktop\Shareenas Report.xlsx" + ";Extended Properties=Excel 8.0;"

   ' Create the Connection and Recordset objects.
   Set conn = New ADODB.Connection
   Set rs = New ADODB.Recordset

   sql = "SELECT * FROM [Data$A1:AC73333]"

   ' Open the connection and execute.
   conn.Open sConnString
   Set rs = conn.Execute(sql)

   ' Check we have data.
   If Not rs.EOF Then
       ' Transfer result.
       Sheets(1).Range("A1").CopyFromRecordset rs
       ' Close the recordset
       rs.Close
   Else
       MsgBox "Error: No records returned.", vbCritical
   End If

   ' Clean up
   If CBool(conn.State And adStateOpen) Then conn.Close
   Set conn = Nothing
   Set rs = Nothing

End Sub

当我尝试打开连接时，我不断收到以下内容。我的连接字符串出了什么问题？

外部表格不是预期的格式

我找到Following并将我的代码更改为：

sConnString = "provider=Microsoft.Jet.OLEDB.12.0;data source=" & _
                  "C:\Users\dblois\Desktop\Shareenas Report.xlsx" + ";Extended Properties=Excel 12.0;"

然后我收到以下错误：

无法找到提供商。它可能不是属性安装

Answer 1

首次尝试时，OLEDB驱动程序不适合Excel文件类型。在第二次尝试中，您有一个不正确的OLEDB驱动程序，因为Jet没有12.0版本。作为@Comintern在您发布的链接中的评论和答案，请使用ACE驱动程序版本。但要注意两种类型，司机和＃39; 32/64位版本必须与您的MS Office位版本或任何其他程序匹配，甚至是您尝试连接到Excel数据源的语言（即PHP，Python，Java）。

对于较旧的Excel .xls文件，您可以使用Jet，因为此引擎尚不知道.xlsx格式，因此无法识别该文件类型：

strConnection = "Provider=Microsoft.JET.OLEDB.4.0;" _
                   & "Data Source='C:\Path\To\Excel.xls';" _
                   & "Extended Properties=""Excel 8.0;HDR=YES;"";"

对于更新的Excel文件（.xlsx，.xlsm，.xlsb），您将使用ACE，它也向后兼容.xls类型：

strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                   & "Data Source='C:\Path\To\Excel.xlsx';" _
                   & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"

或者，使用ODBC，这是许多程序使用的行业应用程序连接层，甚至非Windows系统也可以连接到外部后端源。即使是开源编程语言也可以维护ODBC API，包括PHP的PDO，Python的pyodbc，R＆R的RODBC。

对于较旧的源格式：

strConnection = "DRIVER={Microsoft Excel Driver (*.xls)};" _
                  & "DBQ=C:\Path\To\Excel.xlsx;"

对于较新的源格式：

strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                  & "DBQ=C:\Path\To\Excel.xlsx;"

驱动程序和位验证的相同原则适用于MS Access .mdb vs .accdb版本。

Answer 2

你在说什么？！什么是＆＃34;编写连接字符串和SQL脚本以在Excel中运行查询以从另一个Excel工作簿中提取数据＆＃34; ??

如果要将数据从一个Excel文件复制到另一个Excel文件，请尝试此操作。

Sub VBA_Read_External_Workbook()

    '''''Define Object for Target Workbook
    Dim Target_Workbook As Workbook
    Dim Source_Workbook As Workbook
    Dim Target_Path As String

    '''''Assign the Workbook File Name along with its Path
    '''''Change path of the Target File name
    Target_Path = "D:\Sample.xlsx"
    Set Target_Workbook = Workbooks.Open(Target_Path)
    Set Source_Workbook = ThisWorkbook

    '''''With Target_Workbook object now, it is possible to pull any data from it
    '''''Read Data from Target File
    Target_Data = Target_Workbook.Sheets(1).Cells(1, 1)
    Source_Workbook.Sheets(1).Cells(1, 1) = Target_Data

    '''''Update Target File
    Source_data = Source_Workbook.Sheets(1).Cells(3, 1)
    Target_Workbook.Sheets(1).Cells(2, 1) = Source_data

    '''''Close Target Workbook
    Source_Workbook.Save
    Target_Workbook.Save
    Target_Workbook.Close False

    '''''Process Completed
    MsgBox "Task Completed"

End Sub

或者可能。。。

Sub Write_To_Open_Excel()
    Dim wb As Workbook

    'Reference Workbook with its name
    Workbooks("Book2").Worksheets("Sheet2").Activate
    Workbooks("Book3.xls").Worksheets("Sheet2").Activate

    'Search for Each Opened Workbook
    For Each wb In Workbooks
        If wb.Name = "Book2" Then
            wb.Sheets(1).Cells(1, 1) = "Writing To Open Excel Worksheet - Testing"
        End If
    Next
End Sub

现在，如果您想从SQL Server将数据导入Excel，请尝试此操作。

Sub ADOExcelSQLServer()
     ' Carl SQL Server Connection
     '
     ' FOR THIS CODE TO WORK
     ' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
     '

    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    Server_Name = "EXCEL-PC\EXCELDEVELOPER" ' Enter your server name here
    Database_Name = "AdventureWorksLT2012" ' Enter your database name here
    User_ID = "" ' enter your user ID here
    Password = "" ' Enter your password here
    SQLStr = "SELECT * FROM [SalesLT].[Customer]" ' Enter your SQL here

    Set Cn = New ADODB.Connection
    Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"

    rs.Open SQLStr, Cn, adOpenStatic
     ' Dump to spreadsheet
    With Worksheets("sheet1").Range("a1:z500") ' Enter your sheet name and range here
        .ClearContents
        .CopyFromRecordset rs
    End With
     '            Tidy up
    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing
End Sub

最后，如果要将数据从Excel发送到SQL Server，请尝试此操作。

Sub ButtonClick()
'TRUSTED CONNECTION
    On Error GoTo errH

    Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strPath As String
    Dim intImportRow As Integer
    Dim strFirstName, strLastName As String

    Dim server, username, password, table, database As String


    With Sheets("Sheet1")

            server = .TextBox1.Text
            table = .TextBox4.Text
            database = .TextBox5.Text


            If con.State <> 1 Then

                con.Open "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Integrated Security=SSPI;"
                'con.Open

            End If
            'this is the TRUSTED connection string

            Set rs.ActiveConnection = con

            'delete all records first if checkbox checked
            If .CheckBox1 Then
                con.Execute "delete from tbl_demo"
            End If

            'set first row with records to import
            'you could also just loop thru a range if you want.
            intImportRow = 10

            Do Until .Cells(intImportRow, 1) = ""
                strFirstName = .Cells(intImportRow, 1)
                strLastName = .Cells(intImportRow, 2)

                'insert row into database
                con.Execute "insert into tbl_demo (firstname, lastname) values ('" & strFirstName & "', '" & strLastName & "')"

                intImportRow = intImportRow + 1
            Loop

            MsgBox "Done importing", vbInformation

            con.Close
            Set con = Nothing

    End With

Exit Sub

errH:
    MsgBox Err.Description
End Sub

或者可能。。。

Sub InsertInto()

'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String

'Create a new Connection object
Set cnn = New adodb.Connection

'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Northwind;Data Source=Excel-PC\SQLEXPRESS"
'cnn.ConnectionString = "DRIVER=SQL Server;SERVER=Excel-PC\SQLEXPRESS;DATABASE=Northwind;Trusted_Connection=Yes"


'Create a new Command object
Set cmd = New adodb.Command

'Open the Connection to the database
cnn.Open

'Associate the command with the connection
cmd.ActiveConnection = cnn

'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText

'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2013-01-22' WHERE EMPID = 2"

'Pass the SQL to the Command object
cmd.CommandText = strSQL


'Execute the bit of SQL to update the database
cmd.Execute

'Close the connection again
cnn.Close

'Remove the objects
Set cmd = Nothing
Set cnn = Nothing

End Sub

在Excel VBA中使用SQL访问其他Excel工作簿

2 个答案: