Excel VBA中的SQL Select查询

Question

I have email addresses on Sheet 1 cell A1:A735. I need to use those cell data in a where clause. Currently it is hardcoded. I am fetching data from Sql and want to paste data in Active range A1.

I cannot figure out how to loop through.

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 = 'asif@gmail.com'"

    objMyCmd.CommandType = adCmdText

    Set objMyRecordset.Source = objMyCmd
    objMyRecordset.Open

    ActiveSheet.Range("a1").CopyFromRecordset objMyRecordset

End Sub

Answer 1

You can loop through the cells like so:

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

Answer 2

This should give you a way to call a subroutine the connects for you. You would pass in the parameters required.

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    = 'username@email.com'"
'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

And Then you can loop through your sheet1 emails as required.