将SQL信息提取到Excel中

我过去一直能够创建连接并将整个表格或甚至仅一列或两列从SQL导入到Excel中。将SQL信息提取到Excel中

现在我想让用户输入一个ID到用户窗体中，然后VBA运行SQL代码来获取相应的ID，FirstName，LastName。然后它应该将该信息粘贴到“Entry”表单上的A，B，C的第一个空白行。

我在这行代码中得到一个错误，指出：运行时错误'1004'应用程序定义或对象定义的错误。

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=xxx.xxx.xxx.xxx;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False;Initial Catalog=DBName"), Destination:=Sheets("Entry").Range("A1").End(xlDown).Offset(1, 0)).QueryTable

这其中大部分我不明白这只是一些手我失望的代码，我试图重新目的。旧的代码仍然工作原理是这样的：

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(_ 
     "OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=xxx.xxx.xxx.xxx;Use Procedure for Prepare=1;Auto " _ 
     , _ 
     "Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possibl" _ 
     , "e=False;Initial Catalog=DBName"), Destination:=Range("Database!$A$1")). _ 
     QueryTable

它们之间的区别是，而不是只用代码拉了几十万行数据删除它在一个集小区是我想要的代码是在第一个空白行，只是拉过那一条记录。但是每次运行它都需要进入下一行。

使用旧的代码，它创建了一个实际的表，我猜测它与最终表明QueryTable的事实有关。我宁愿只有数据而不是表格格式。如果有办法改变它来做到这一点会很好。

此外，在该查询的以前版本中，查询只从一个表格和.SourceConnectionFile = _链接到该文件。新代码将需要链接到两个表，所以有两个文件，因为我无法让它选择两个表来创建连接文件。如果你能帮上忙，那也会很棒。

我正在使用Excel 2013 Standard和SQL Server 2012.请让我知道是否需要更多信息。

所以这就是我到目前为止尝试使用@Kyle建议的ADO方法。 OCR是以前代码中用户窗体的变量输入。当它运行时，它不会给出错误，但它不会粘贴任何数据。

Sub Code() 

    Sheets("Entry").Select 

    On Error Resume Next 

Const adOpenStatic = 3 
Const adLockOptimistic = 3 
Const adCmdText = &H1 

Set objConnection = CreateObject("ADODB.Connection") 
Set Objrecordset = CreateObject("ADODB.Recordset") 

ConnectionString = "Provider=SQLOLEDB;Data Source=xxx.xxx.xxx.xxx;Initial Catalog=DBName;User ID=MyUN;Password=MyPW" 
objConnection.Open 


Objrecordset.Open "Select B.ID, B.Firstname, B.Lastname From TableA as A Join TableB as B on A.ID = B.ID Where A.Cardnumber =" & OCR, objConnection, adOpenStatic, adLockOptimistic, adCmdText 

If Not Objrecordset.EOF Then 
    Sheets("Entry").Range("A1").End(xlDown).Offset(1, 0).CopyFromRecordset Objrecordset 
    Objrecordset.Close 
Else 
MsgBox "Did not Work" 
End If

末次

来源

2016-06-20 Chad Portman

我建议录制宏，而你手动建立了这个（而不是作为一个表）。然后用一个变量替换给定的id并设置一个单元格引用来捕获下一个可用的行。 –

我不知道如何手动执行此操作。这是你可以用@ScottHoltzman帮助我吗？ –

两张桌子之间的连接是什么？ – Rory

所以我能得到它与这方面的工作：

Sub Code() 

    Sheets("Entry").Select 

    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 = "" ' Enter your server name here 
    Database_Name = "" ' Enter your database name here 
    User_ID = "" ' enter your user ID here 
    Password = "" ' Enter your password here 
    SQLStr = "SELECT B.ID, B.FirstName, B.LastName From Table A Join Table B as B on A.ID = B.ID Where A.CardNumber ='" & OCR & "'" ' 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("Entry").Range("A1").End(xlDown).Offset(1, 0) ' 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

来源

2016-06-20 20:34:42

将SQL信息提取到Excel中

回答

相关问题