Loop a process

[radder33]

I am trying to get the loop within this code to work, as a one off it works fine but I don't know how to make the process run until all records are updated and the report returns a null value? Any help woul be great.

Private Sub Command42_Click()
DoCmd.SetWarnings False
On Error GoTo Err_Command50_Click

DoCmd.OpenReport "Account Details", acViewPreview, , , acWindowNormal, ""
Do
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.GetDatabase("", "")
Call notesdb.OpenMail
Rem make new mail message
Set notesdoc = notesdb.CreateDocument
Call notesdoc.replaceitemvalue("Sendto", "xxxxxx@xxxxx.com")
Call notesdoc.replaceitemvalue("Subject", "Problem Report")
Set notesrtf = notesdoc.createrichtextitem("body")
Call notesrtf.appendtext("Problem Report")
Call notesrtf.addnewline(2)
DoCmd.SendObject acSendReport, "Account Details", acFormatPDF, [Reports]![Schlüter Elearning Account Details]!, , , "Account Inactive", "account has been inactive", False
Call notesdoc.Send(False)
Set notessession = Nothing

DoCmd.OpenQuery "UpdateDeactNoteSent", acViewNormal, acEdit
DoCmd.Close acQuery, "UpdateDeactNoteSent", acSaveYes
DoCmd.Close acReport, "Account Details", acSaveYes

Loop Until [Reports]![Account Details]![UserName] Is Null

Exit_Command50_Click:
Exit Sub

Err_Command50_Click:
MsgBox Err.Description
Resume Exit_Command50_Click
DoCmd.SetWarnings True
End Sub

 

[MajP]

I do not get the report thing. But I will assume the report returns a filtered query and you want to run this for each record returned by the report.

dim rs as dao.recordest
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object

'I am not familiar with this object but assume it gets opened once
'If not move into loop  

Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.GetDatabase("", "")
Call notesdb.OpenMail

DoCmd.OpenReport "Account Details", acViewPreview, , , acWindowNormal, ""
set rs = reports("Account Details").recordset

Do while not rs.eof
   Set notesdoc = notesdb.CreateDocument
   Call notesdoc.replaceitemvalue("Sendto", "xxxxxx@xxxxx.com")
   Call notesdoc.replaceitemvalue("Subject", "Problem Report")
   Set notesrtf = notesdoc.createrichtextitem("body")
   Call notesrtf.appendtext("Problem Report")
   Call notesrtf.addnewline(2)
   DoCmd.SendObject acSendReport, "Account Details", acFormatPDF, [Reports]![Schlüter Elearning Account Details]![Email], , , "Account Inactive", "account has been inactive", False
   Call notesdoc.Send(False)
   DoCmd.OpenQuery "UpdateDeactNoteSent", acViewNormal, acEdit
   DoCmd.Close acQuery, "UpdateDeactNoteSent", acSaveYes
   DoCmd.Close acReport, "Account Details", acSaveYes
   rs.movenext
loop

 

[radder33]

I get Run-time error '32585 this feature is only available in adp on this line?

set rs = reports("Account Details").recordset

 

[MajP]

try this
dim strSql as string
'strSql = "A sql string the same as the report recordsource"
'or after you open the report
strSql = reports("Account Details").recordsource
set rs = currentdb.openrecordset(strSql, DBopendynaset)

 

[radder33]

That solves part of the problem in that it loops to send the correct e mails but they all get the same attachment.

I either need to create a report for each e mail or be able to put the account details for each user in the individual e mail?

Thankyou for the initial input.

 

[MajP]

Not sure what each report is. I will asssume they are individual account reports. So the recordset loops all possible accounts, and the loop opens an email for each account.

 dim rs as dao.recordest
 Dim notesdb As Object
 Dim notesdoc As Object
 Dim notesrtf As Object
 Dim notessession As Object
 dim strSql as string
 dim strCriteria as string 
 
 strSql = "A sql string to get the correct reports to open"
 
 set rs = currentdb.openrecordset(strSql, DBopendynaset)
 Set notessession = CreateObject("Notes.Notessession")
 Set notesdb = notessession.GetDatabase("", "")
 Call notesdb.OpenMail
Do while not rs.eof
   Set notesdoc = notesdb.CreateDocument
   Call notesdoc.replaceitemvalue("Sendto", "xxxxxx@xxxxx.com")
   Call notesdoc.replaceitemvalue("Subject", "Problem Report")
   Set notesrtf = notesdoc.createrichtextitem("body")
   Call notesrtf.appendtext("Problem Report")
   Call notesrtf.addnewline(2)
  [b] 
  'some criteria to filter the report
   strCriteria = "AccountID = " & rs!AccountID
   DoCmd.OpenReport "Account Details", acViewPreview, ,strCriteria , acWindowNormal, ""
   [/b]
   DoCmd.SendObject acSendReport, "Account Details", acFormatPDF, [Reports]![Schlüter Elearning Account Details]![Email], , , "Account Inactive", "account has been inactive", False
   Call notesdoc.Send(False)
   DoCmd.OpenQuery "UpdateDeactNoteSent", acViewNormal, acEdit
   DoCmd.Close acQuery, "UpdateDeactNoteSent", acSaveYes
   DoCmd.Close acReport, "Account Details", acSaveYes
   rs.movenext
loop

 

[radder33]

It still doesn't do the individual reports it creates the correct amount of e mails but just keeps the one reports open.

I could be really over complicating this as I have the info required all in one table so would it be simpler to set the table as the recordset and then set fields as strings and put them in the e mail?

Excuse me if I am going way off here but I don't know a great deal about recordsets and loops.

 

[MajP]

Yes, if all you need is a simple email without a complicated formatting.

Here would be a simple example. A query pulls the relevant fields and records from a table. Each record would provide the data for the email. You can do a lot of formatting in the query instead of in your code.

if in your query you could do something like
select firstName & " " & lastName as FullName ..

Now in you code below you could call rs!FullName and get
John Smith.

You can even concatenate a bunch of fields that contain the body of the message and then just reference that

select problemSubject & "( " & startDate & " to " & endDate & ")" & vbcrlf & ProblemNotes AS EmailBody ....

then reference rs!EmailBody

  dim rs as dao.recordset
  dim strSql as string
  dim strEmail as string
  strSql = "SomeQueryWithProperFieldsAndRecords"
  set rs = currentdb.openrecordset(StrSql,dbopendynaset)
  
  'other Notes code here
  do while not rs.eof
     strMsg = ""
     
     strMsg = " For the following Account: " & rs!accountID & vbcrlf
     strMsg = strMsg & " The account had a problem on: " & rs!problemdate & vbcrlf
     strMsg = strMsg & " The probelm was: " & rs!accountProblem
     'code that sends email 
     notesdoc.body = strMSg
     rs.movenext
   loop

that would make a message like
"For the following Account: 1234ABCD
The account had a problem on: 1/1/2011
The problem was: Inactive account due to late payment."

 

[radder33]

I get runtime error 7369 no form associated with document and when I debug it goes to the line that reads

Call notesdoc.Send(True)

I have reposted the code as it now seems quite different to the original

Dim rs As DAO.Recordset
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Dim strSql As String
Dim strMsg As String

strSql = ("DeactivateElearningTrim")
Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.getdatabase("", "")
Call notesdb.OpenMail


Do While Not rs.EOF
strMsg = ""

strMsg = "Account: " & rs![UserName] & vbrclf
strMsg = strMsg & "The account has been inactive since it was created" & vbCrLf
strMsg = strMsg & "If the account remains inactive for a further 7 days it will be deactivated."
Set notesdoc = notesdb.CreateDocument
Call notesdoc.replaceitemvalue("Sendto", rs!)
Call notesdoc.replaceitemvalue("Subject", "Inactive Report")
notesdoc.body = strMsg
Call notesdoc.Send(True)
rs.MoveNext
Loop
End Sub

 

[MajP]

As previously stated I am not familiar with this Notes object. Is this the MS OneNote? I guessed at this line:
notesdoc.body = strMsg
That is probably not how you fill the body of the message.

 

[radder33]

No sorry if I wasn't clear its a Lotus Notes e mail.

 

[MajP]

Okay referencing this

http://stackoverflow.com/questions/...ed-lotus-notes-rich-text-email-from-excel-vba

looks like you should use the .appendtext method

'Create 'Body' of memo
Set notesrtf = notesdoc.createrichtextitem("body")
notesrtf.APPENDTEXT strMsg

 

[radder33]

Hello I was dragged away from this I now get a notes error that no names found to send e mail to.

When I debug it goes to notesdoc.send (False)

The recordset id finding correct details because when I hover over them it does show the underlying names.

Private Sub Command42_Click()

Dim rs As DAO.Recordset
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Dim strSql As String
Dim strMsg As String

strSql = ("DeactivateElearningTrim")
Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.getdatabase("", "")
Call notesdb.OpenMail


Do While Not rs.EOF
Set notesdoc = notesdb.CreateDocument
Call notesdoc.replaceitemvalue("Sendto", rs!)
Call notesdoc.replaceitemvalue("Subject", "Inactive Report")
Set notesrtf = notesdoc.createrichtextitem("Body")

notesrtf.appendtext strMsg

strMsg = ""

strMsg = "Elearning Account: " & rs![UserName] & vbrclf
strMsg = strMsg & "The account has been inactive since it was created" & vbCrLf
strMsg = strMsg & "If the account remains inactive for a further 7 days it will be deactivated."

notesdoc.body = strMsg
Call notesdoc.Save(True, Salse, False)
notesdoc.savemessageonsend = True
notesdoc.send (False)

rs.MoveNext
Loop
End Sub