SQL Select query in Excel VBA - sql

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.