SQL Select query in Excel VBA

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 ADOD开发者_运维知识库B.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

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

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.