2011-06-17 130 views
0

我在Sheet 1單元格A1:A735上有電子郵件地址。我需要在where子句中使用這些單元格數據。目前它是硬編碼的。我從Sql中獲取數據並想要將數據粘貼到Active range A1中。在Excel VBA中選擇查詢

我無法弄清楚如何循環。

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 

回答

0

這應該給你一個方法來爲你調用一個連接子程序。你會傳遞所需的參數。

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 

然後,您可以根據需要循環查看sheet1電子郵件。

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