2011-06-17 76 views
0

我在Sheet 1单元格A1:A735上有电子邮件地址。我需要在where子句中使用这些单元格数据。目前它是硬编码的。我从Sql中获取数据并想要将数据粘贴到Active range A1中。在Excel VBA中选择查询

我无法弄清楚如何循环。

Sub GetDataFromADO() 

    Dim objMyConn As ADODB.Connection 
    Dim objMyCmd As ADODB.Command 
    Dim objMyRecordset As ADODB.Recordset 
    Dim Email2 As Range 
    Dim Worksheet1 As Worksheet 

    Set objMyConn = New ADODB.Connection 
    Set objMyCmd = New ADODB.Command 
    Set objMyRecordset = New ADODB.Recordset  

    objMyConn.ConnectionString = "some connection string ;" 
    objMyConn.Open 

    Set objMyCmd.ActiveConnection = objMyConn 
    objMyCmd.CommandText = "SELECT * FROM [abc].[dbo].[excusers] where email = '[email protected]'" 

    objMyCmd.CommandType = adCmdText 

    Set objMyRecordset.Source = objMyCmd 
    objMyRecordset.Open 

    ActiveSheet.Range("a1").CopyFromRecordset objMyRecordset 

End Sub 

回答

0

这应该给你一个方法来为你调用一个连接子程序。你会传递所需的参数。

Sub adocnnRoutine_SP(ByVal ReturnVal As String, ByVal cnnstr As String, ByVal CallVal As Range, Optional CallHDR As Range) 
'ReturnValue is the string to send to SQL Such as "Select * from TableName where email = '[email protected]'" 
'CallVal places the results in that one cell as a starting point Such as Sheet2.Range("A2") 
'CallHDR is optional header placement point Such as Sheet2.Range("A1") 


Dim cn As ADODB.Connection, rs As ADODB.RECORDSET 

Set cn = New ADODB.Connection 
Set rs = New ADODB.RECORDSET 

On Error GoTo CleanUp 
cn.Open cnnstr 
rs.Open ReturnVal, cnnstr 



If Not CallHDR Is Nothing Then 

With CallHDR 
    For Each field In rs.Fields 
     .Offset(0, Offset).Value = field.Name 
     Offset = Offset + 1 
    Next field 
    End With 

End If 

CallVal.CopyFromRecordset rs 

CleanUp: 


Debug.Print Err.Description 

cn.Close 
Set rs = Nothing 
Set cn = Nothing 



End Sub 

然后,您可以根据需要循环查看sheet1电子邮件。

1

你可以通过细胞像这样的循环:

With Sheet1 
For i = 1 To 735 
    sText = "SELECT * FROM [abc].[dbo].[excusers] where email = '" _ 
      & Replace(.Cells(1, i), "'", "''") & "'" 
    objMyCmd.CommandText = sText 
Next 
End With