Logic problem Excel VBA returning Access Data 2

[RonRepp]

Hi all:
I'm having a slight logic problem that I cannot figure out. What the client wants is to find out if the email address is active or not, and since the DB may (and does) contain more than one status for opting out, I'm forced to return the values width-wise instead of like a table. The procedure works great for the first name only.

Sub CreateMailList()

    Dim Cat As ADOX.Catalog
    Dim Con As ADODB.Connection
    Dim RS As ADODB.Recordset
    Dim numRecords As Long
    Dim i As Long
    Dim SQL As String
    Dim Q As String
        
        Set Cat = New ADOX.Catalog
        Set Con = New ADODB.Connection
        Set RS = New ADODB.Recordset

        Q = Chr(34)

   
    Sheets("Mail Chimp").Select
    Range("A1").Select
    
Do

    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Value = "" Then Exit Sub
    s = ActiveCell.Text
    i = 3
    Con.Provider = "Microsoft.ACE.OLEDB.12.0" '"Microsoft.Jet.OLEDB.4.0"
    Con.Open "Data Source=C:\Users\Repp-Web\Downloads\Agents2Email.accdb"
   
   
   SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "GROUP BY qRealtors2OffAddZipEmail.RStat, qRealtors2OffAddZipEmail.Email1 " & _
        "HAVING (((qRealtors2OffAddZipEmail.Email1)=" & Q & s & Q & "));"
      
      'Debug.Print SQL
      
   RS.Open SQL, Con, adOpenDynamic, adLockOptimistic, adCmdText
   
   Do While Not RS.EOF
            s = RS(0).Value
         
[b]'here is the problem (I think)[/b]
   
            If ActiveCell.Offset(0, i).Value = "" Then
                ActiveCell.Offset(0, i).Value = s
                i = i + 1
            Else
                i = i + 1
                ActiveCell.Offset(0, i).Value = s
            End If
            
   
        RS.MoveNext
   Loop
            

    On Error Resume Next
            RS.Close
            Set RS = Nothing
            Con.Close
            Set Con = Nothing
Loop

End Sub

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[SkipVought]

HI,

Check out Faq707-4594.

With this 'tool' you can check specific values, properties etc

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[combo]

In the loop:

If ActiveCell.Offset(0, i).Value = "" Then
    ActiveCell.Offset(0, i).Value = s
    i = i + 1
Else
    i = i + 1
    ActiveCell.Offset(0, i).Value = s
End If

you check the cell i rows below active cell, if is empty assign s, else assign s to next row, without checking contents. Whatever you did, i becomes i+1. Is it what you plan to do? Have you checked RS contents?


combo

 

[RonRepp]

Hi Skip:

Thanks for the thought. I don't use the Watch Window a lot, but I was using the Immediate Window with Debug.Print on the variables to see them change. I removed them before I posted the code.

I did take your advice, though, but still prefer the Immediate Window. You've helped me too many times over the years not to at least try something innocuous.

Thanks,

Ron

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[RonRepp]

Combo:

Thanks for your reply.

Yes, that is what I planned to do, because I need the data to show on the spreadsheet like a crosstab report. I'm given a spreadsheet with the email addresses (all in Column A) and the client wants all the opt-out statuses in line with the email address.

I did find one problem in logic, but still not the answer. The code gives me the correct # of records, but keeps returning the first value. Here is how I changed the code. I also added the variable T to make sure those weren't getting confused (even in my head)

[b]'Con.Open & Con.Provider removed from here[/b]
Do

    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Value = "" Then Exit Sub
    S = ActiveCell.Text [COLOR=#3465A4]'this is an email address[/color]
    i = 3 [COLOR=#3465A4]'I start with 3 because the client has already placed some of his statuses in Column D, but they do not adhere to the database[/color]
    
[b]Con.Open & Con.Provider moved to here[/b]
    [b]Set Con = New ADODB.Connection
    Set RS = New ADODB.Recordset[/b]
    
    Con.Provider = "Microsoft.ACE.OLEDB.12.0" '"Microsoft.Jet.OLEDB.4.0"
    Con.Open "Data Source=C:\Users\Repp-Web\Downloads\Agents2Email.accdb"
   
   
  SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "GROUP BY qRealtors2OffAddZipEmail.RStat, qRealtors2OffAddZipEmail.Email1 " ' & _
        '"HAVING (((qRealtors2OffAddZipEmail.Email1)=" & Q & S & Q & "));"
      
      'Debug.Print SQL
      
    'SQL = "SELECT qRealtors2OffAddZipEmail.RStat" & _
        " FROM qRealtors2OffAddZipEmail " & _
        "WHERE (((qRealtors2OffAddZipEmail.Email1)=" & Q & S & Q & "));"
      
   RS.Open SQL, Con, adOpenDynamic, adLockOptimistic, adCmdText
   
   Do While Not RS.EOF
            T = RS(0).Value
            
            
            If ActiveCell.Offset(0, i).Value = "" Then
                ActiveCell.Offset(0, i).Value = T
                i = i + 1
            Else
                i = i + 1
                ActiveCell.Offset(0, i).Value = T
            End If
            
   
        RS.MoveNext
   Loop
            

    'On Error Resume Next
            RS.Close
            Set RS = Nothing
            Con.Close
            Set Con = Nothing
Loop

Thanks,

Ron

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net