CODEWITHSUNDEEP
sqlexcelvbaloops
user802774
user802774

Reputation: 1

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 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

Upvotes: 0

Views: 2502

Answers (2)

Fionnuala
Fionnuala

Reputation: 91316

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

Upvotes: 1

lionz
lionz

Reputation: 505

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    = '[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

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

Upvotes: 0

Related Questions