Запрос SQL Select в Excel VBA

Question

У меня есть адреса электронной почты на листе 1, ячейка A1: A735.Мне нужно использовать эти данные ячейки в предложении where.В настоящее время это жестко закодировано.Я извлекаю данные из Sql и хочу вставить данные в активный диапазон A1.

Я не могу понять, как пройти через цикл.

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

Вы можете проходить по клеткам следующим образом:

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

Это должно дать вам возможность вызывать подпрограмму connect для вас.Вы должны передать требуемые параметры.

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

И затем вы можете при необходимости просмотреть свои электронные письма листа1.