Loop through recordset

[Dachande]

Hello,

I am trying to create a recordset and then step through the records one at a time, each time passing the record from a field to a text box on a form (I am doing this just to see if it works). But unfortunately I cannot get it to work.

Ultimately I will use this code to step through a table and send emails to the recipients listed in the table (I got the email bit working).

Any help would be greatly appreciated as I am pulling my hair out now.


Thanks

Mark

 

[Mile-O]

I am trying to create a recordset and then step through the records one at a time, each time passing the record from a field to a text box on a form (I am doing this just to see if it works). But unfortunately I cannot get it to work.

What do you have thus far?

 

[Dachande]

Sorry Mile was in too much of a rush,

Private Sub Email_Click()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim CICODE As String

    Set conn = CurrentProject.Connection

    Set rst = New ADODB.Recordset

    rst.Open "SELECT Target_June2003.[CI Code], Target_June2003.[Business Manager], Target_June2003.Active " & _
        "FROM Target_June2003 WHERE (((Target_June2003.Active)=True));", conn, adOpenDynamic

    rst.MoveFirst

    Do While Not rst.EOF
        CICODE = rst![CI Code]
        Me.test = CICODE

        rst.MoveNext

    Loop

    rst.Close

End Sub

 

[Mile-O]

Are you receiving any errors? If so, what line do they stall at?

Also, Target_June2003 should be enclosed within square brackets. [Target_June2003]

Aside, is [Target_June2003] a query or a table. If it's a table then I'm curious as to why you'd have a table relative to such a time period.

 

[Dachande]

Thank you for your reply Mile,

I have been getting no errors at all. With regards to the weird table name that is because somebody setup a wholesaler targets file and decided to call it that, I have no idea why and do not want to change it as so many people seem to link into it.

As I was saying I got no errors so thought I would try and put the email code in. The following is the code I hope to get working to automatically send out emails and attachments. I have also added the error message I get when running this new code.

"Either BOF or EOF is true, or the current record has been deleted. Requested operation requires a current record."


Option Compare Database

Private Sub Email_Click()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim CICODE As String

Set conn = CurrentProject.Connection

Set rst = New ADODB.Recordset

rst.Open "SELECT [Target_June2003].[CI Code], [Target_June2003].[Business Manager], [Target_June2003].Active " & _
"FROM [Target_June2003] WHERE ((([Target_June2003].Active)=True));", conn, adOpenDynamic

rst.MoveFirst

Do While Not rst.EOF And Not rst.BOF
CICODE = rst![CI Code]
'Me.test = CICODE


'Email code
Dim conn1 As ADODB.Connection
Dim rst1 As ADODB.Recordset

Dim Originator As String

Set conn1 = CurrentProject.Connection

Set rst1 = New ADODB.Recordset

Dim Attachment As String
Dim AttachME As Object 'The attachment richtextfile object
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim EmailSend As Object
Dim EmailApp As Object


rst1.Open "SELECT MasterWholesaler.ci_code, MasterWholesaler.Email1, MasterWholesaler.email2 From MasterWholesaler " & _
"WHERE ([MasterWholesaler.ci_code])= '" & CICODE & "' ;", conn1, adOpenForwardOnly, adLockReadOnly, adCmdTableDirect


'Array for multiple addresses
Dim recip(2) As Variant
recip(0) = rst1!Email1
recip(1) = rst1!Email2


'EmailAddress = rst!email_address

Dim s As Object
Dim db As Object
Dim doc As Object
Dim rtItem As Object
Dim Server As String, Database As String
Dim strError As String

Set s = CreateObject("Notes.notesSession")
Server = s.GETENVIRONMENTSTRING("MailServer", True)
Database = s.GETENVIRONMENTSTRING("MailFile", True)
Set db = s.GETDATABASE(Server, Database)


'see if user is logged on
Set doc = db.CREATEDOCUMENT
'On Error GoTo 0
doc.Form = "Memo"
doc.importance = "1" '(Where 1=Urgent, 2= Normal, 3= FYI)

doc.sendto = recip ' Used for multiple addresses see array above

doc.RETURNRECEIPT = "1"
doc.Subject = "CBA report for - " & Originator

Set rtItem = doc.CreateRichTextItem("Body")
Call rtItem.APPENDTEXT("Dear Parts Manager,")
Call rtItem.ADDNEWLINE(2)
Call rtItem.APPENDTEXT("Please find attached this weeks CBA report for - ")
Call rtItem.ADDNEWLINE(2)
Call rtItem.APPENDTEXT("Kind Regards")
Call rtItem.ADDNEWLINE(2)
Call rtItem.APPENDTEXT("MG Rover Communications")

'Set AttachME = MailDoc.CreateRichTextItem.Add("C:\Documents and Settings\szymkm\Desktop\test.txt")
'Set EmbedObj = AttachME.EmbedObject(1454, "", "C:\Documents and Settings\szymkm\Desktop\test.txt")

Set AttachME = doc.CreateRichTextItem("C:\Documents and Settings\szymkm\Desktop\" & CICODE & ".txt")
Set EmbedObj = AttachME.EmbedObject(1454, "", "C:\Documents and Settings\szymkm\Desktop\" & CICODE & ".txt")


Call doc.Send(False)


Set doc = Nothing
Set db = Nothing
Set s = Nothing
Set rtItem = Nothing

rst1.Close

ErrorLogon:
If Err.Number = 7063 Then
MsgBox " You must first logon to Lotus Notes"
ElseIf Err.Number = 7000 Then
MsgBox "There is no email address for " & CICODE
End If


rst.MoveNext

Loop

rst.Close

End Sub



Thanks again for your help

Mark

 

[Dachande]

Hello Mile,

It seems that the code is actually working and sending the emails but coming up with the error at the end. How can I prevent this?

Thanks

Mark

 

[Mile-O]

You've lost me at the Mail Object part; I've never learnt that as I've never needed it.

You could trap it and deal with it with the Error Handling structure:

Private Sub MySub()
    On Error Goto Err_ErrorHandler

   ' sub body

Exit_ErrorHandler:
    Exit Sub

Err_ErrorHandler:
    If Err.Number = ???? Then
        ' deal with it
    Else
        MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    End If
    Resume Exit_ErrorHandler
End Sub

Could I ask, please, if you are going to post long pieces of code that you use the [CODE] [/CODE] tags on either side of it? Thanks

 

[Dachande]

Ok I will do that in future, thanks very much for your help.

Mark