Loop through records 2

[kiwieur]

I have the following code which if a record exists creates a PDF and sends an e-mail

Public Function SendMail()

Dim strFilename As String
Dim strNewName As String
Dim strHead As String
Dim strSub As String
Dim ddate As String
Dim strfrp As String
Dim strPlant As String

Dim rsCount As Integer
rsCount = DCount("*", "QryLoadNo")
If rsCount = 0 Then 'Check to see if there are any records, if not quit the application
DoCmd.CancelEvent

Else


DoCmd.OpenForm "frmDespatchData", acNormal

DoCmd.OpenReport "rptLoadDetails", acViewPreview, "", "", acNormal

strFilename = Forms![frmDespatchData]![lstCustomer]
strSub = " "
strLoadID = Forms![frmDespatchData]![txtLoadID]
strPlant = Forms![frmDespatchData]![txtPlant]

D = Format(Now, "dd")
m = Format(Now, "mm")
Y = Format(Now, "yy")

ddate = D & "-" & m & "-" & Y

strHead = "Pallet Transfer Details From " & strPlant & " To Wellington Dated " & ddate & " Load ID_" & strLoadID

strNewName = DLookup("[Path]", _
    "tblWMail_FilePaths", "[Type] = 'E-mail'") & strFilename & "_" & ddate & "_" & "LoadID_" & strLoadID & ".pdf"


Call SaveReportAsPDF("rptLoadDetails", strNewName)

 Dim patha, pathT, pathC, pathH, pathS, CustMailTo, CustMailCC As String

CustMailTo = Forms![frmDespatchData]![txtContact1]
CustMailCC = Forms![frmDespatchData]![txtContact2]
patha = strNewName

strSub = "This Is A Test Message In Regards To Transfers" & _
vbCrLf & vbCrLf & _
"Please find attached Transfer Details For Load ID" & strLoadID & _
vbCrLf & vbCrLf & _
vbCrLf & vbCrLf & _
"PLEASE NOTE: Do Not Reply To This E-Maill Address. If You Require Information Regarding This Transfer" & _
vbCrLf & vbCrLf & _
"Please Contact The Relevant Site"

pathT = CustMailTo
pathC = CustMailCC
pathH = strHead
pathS = strSub

Dim Session As vbMAPI_Session
Dim Store As vbMAPI_Store
Dim Folder As vbMAPI_Folder
Dim FolderItems As vbMAPI_FolderItems
Dim Item As vbMAPI_MailItem

Set Session = vbMAPI_Init.NewSession
Session.LogOn

Set Store = Session.Stores.DefaultStore

Set Folder = Store.GetDefaultFolder(FolderType_Drafts)

Set FolderItems = Folder.Items

Set Item = FolderItems.Add

Item.To_ = pathT ' Add the To recipient(s) to the message.
Item.CC = pathC ' Add the CC recipient(s) to the message.
Item.Subject = pathH ' Set the Subject
Item.Body = pathS 'Set The Body
Item.Importance = Importance_High 'Set The Importance of the message.
Item.Attachments.Add patha ' Add Any Attachments

With Session.AddressBook.ResolveName("deliverynotification@xxxxx.co.uk") ' Set the "From" field
    Item.SenderName = .Name
    Item.SenderEntryID = .EntryID
    Item.SenderSearchKey = .SearchKey
    Item.SentOnBehalfOfName = .Name
    Item.SentOnBehalfOfEntryID = .EntryID
    Item.SentOnBehalfOfAddressType = .AddressType
    Item.SentOnBehalfOfEmailAddress = .Address
    Item.SentOnBehalfOfSearchKey = .SearchKey
End With

For Each Recipient In Item.Recipients ' Resolve each Recipient's name.
    Recipient.Resolve
Next

On Error Resume Next

        Item.Display

        If Err.Number = MAPI_E_USER_CANCEL Then

            MsgBox "User cancelled the Outlook dialog.  Continuing…"

        ElseIf Err.Number <> 0 Then

            MsgBox Err.Description ' Some other error

        End If

        On Error GoTo 0    ' turns off previous ‘on error resume next’ statement
        
DoCmd.OpenQuery "QryWM02b_Update_Sent", acViewNormal

End If

End Function

Now I may have more than one outstanding record in my table but "QryLoadNo" only shows the one record at a time so that I can create the PDF & E-mail to the relevant user after sending the e-mail I then update the record to complete status, sometimes there may only be one outstanding record. what I would like is that it will run the code if a outstanding record exists and then run the code again if there is another outstanding record in "QryLoadNo" but I am unsure on how to create a loop to do this

Any help would be much appreciated



Regards

Paul

 

[1DMF]

to loop a record set you use the following syntax

Dim rs as DAO.Recordset
Set rs = CurrentDb.OpenRecordset("myQuery", dbOpenSnapshot, dbSeeChanges)
 
Do While Not rs.EOF

  ' do something , perhaps call the mailer program

  rs.MoveNext

Loop

Set rs = nothing

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[kiwieur]

Hi 1DMF,

Thanks for your response, I tried running the following code

Public Function SendData()

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("QryLoadNo", dbOpenSnapshot, dbSeeChanges)
 
Do While Not rs.EOF

  ' do something , perhaps call the mailer program
  Call SendMail

  rs.MoveNext

Loop

Set rs = Nothing

End Function

So my query had 2 records,

LoadID	CustomerNo	TransPlant	Customer	       Contact1	        Contact2	             Plant	Sent
17020	16	         Wellington       A N Other       Paul Oliver	       Paul Oliver	  Desborough	0
17049	36	         Wellington       A N Other	      Paul Oliver	       Paul Oliver	    Selby	0

and I set it to call the send mail function however even though I had 2 records in my query it only created a PDF and it mailed it for the first record 17020

Regards

Paul

 

[Andrzejek]

It is hard to see your SendMail function(?) since it displays all in one line.

You could modify your SendMail to accept some parameters:

Public Sub SendMail(strName As String, intNo As Integer, ...)

(You can have it as Sub because right now it is a Funtion, but you don't return any value, so why use Function?)

This way you can pass some parameters to be used in your SendMail:

Do While Not rs.EOF
  ' do something , perhaps call the mailer program
  Call SendMail(rs!SomeField.Value, rs!anotherField.Value, ...)

  rs.MoveNext
Loop

Have fun.

---- Andy

 

[1DMF]

All you are doing currently is calling sendmail x number of times So I assume you sent two emails to the same one record?

It seems your mailer program only ever emails the first record, is this correct?

You need to modify the way the mailer works. Where is it getting the details of who to email?

Is it from the form that opens (frmDespatchData) ?

What is the PK of each record needing to be emailed, can you get that from 'QryLoadNo' perhaps 'LoadID' ?

Could you then pass it to the mailer program so the form that opens uses a Filter so the form bound query ( I assume to also be 'QryLoadNo' ) selects the record based on PK being passed in..

Call SendMail(rs.Fields("LoadID"))

And then have the mailer open the form with...

Public Function SendMail(ByVal iLoadID As Integer)

...

DoCmd.OpenForm "frmDespatchData", acNormal, , "LoadID = " & iLoadID

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[kiwieur]

1DMF & Andrzejek,

Again thanks for both of your responses.

Since the first suggestion from 1DMF I have been working on my code and I now added the e-mail code into my loop and I also had to close my form and report after sending the mail to make it work.

This is the code I have at the moment and it seems to be working OK however I am sure it could be cleaned up.

Public Function SendData()

Set mydb = CurrentDb()
Set rs = mydb.OpenRecordset("QryLoadNo", dbOpenSnapshot)
With rs
.MoveFirst
Do Until rs.EOF
If IsNull(rs.Fields(2)) = False Then

Dim strFilename As String
Dim strNewName As String
Dim strHead As String
Dim strSub As String
Dim ddate As String
Dim strfrp As String
Dim strPlant As String

DoCmd.OpenForm "frmDespatchData", acNormal

DoCmd.OpenReport "rptLoadDetails", acViewPreview, "", "", acNormal

strFilename = Forms![frmDespatchData]![lstCustomer]
strSub = " "
strLoadID = Forms![frmDespatchData]![txtLoadID]
strPlant = Forms![frmDespatchData]![txtPlant]

D = Format(Now, "dd")
m = Format(Now, "mm")
Y = Format(Now, "yy")

ddate = D & "-" & m & "-" & Y

strHead = "Pallet Transfer Details From " & strPlant & " To Wellington Dated " & ddate & " Load ID_" & strLoadID

strNewName = DLookup("[Path]", _
    "tblWMail_FilePaths", "[Type] = 'E-mail'") & strFilename & "_" & ddate & "_" & "LoadID_" & strLoadID & ".pdf"


Call SaveReportAsPDF("rptLoadDetails", strNewName)

 Dim patha, pathT, pathC, pathH, pathS, CustMailTo, CustMailCC As String

CustMailTo = Forms![frmDespatchData]![txtContact1]
CustMailCC = Forms![frmDespatchData]![txtContact2]
patha = strNewName

strSub = "Wellington Transfers" & _
vbCrLf & vbCrLf & _
"Please find attached Transfer Details For Load ID " & strLoadID & _
vbCrLf & vbCrLf & _
vbCrLf & vbCrLf & _
"PLEASE NOTE: Do Not Reply To This E-Maill Address. If You Require Information Regarding This Transfer" & _
vbCrLf & vbCrLf & _
"Please Contact The Relevant Site"

pathT = CustMailTo
pathC = CustMailCC
pathH = strHead
pathS = strSub

Dim Session As vbMAPI_Session
Dim Store As vbMAPI_Store
Dim Folder As vbMAPI_Folder
Dim FolderItems As vbMAPI_FolderItems
Dim Item As vbMAPI_MailItem

Set Session = vbMAPI_Init.NewSession
Session.LogOn

Set Store = Session.Stores.DefaultStore

Set Folder = Store.GetDefaultFolder(FolderType_Drafts)

Set FolderItems = Folder.Items

Set Item = FolderItems.Add

Item.To_ = pathT ' Add the To recipient(s) to the message.
Item.CC = pathC ' Add the CC recipient(s) to the message.
Item.Subject = pathH ' Set the Subject
Item.Body = pathS 'Set The Body
Item.Importance = Importance_High 'Set The Importance of the message.
Item.Attachments.Add patha ' Add Any Attachments

With Session.AddressBook.ResolveName("deliverynotification@rigid.co.uk") ' Set the "From" field
    Item.SenderName = .Name
    Item.SenderEntryID = .EntryID
    Item.SenderSearchKey = .SearchKey
    Item.SentOnBehalfOfName = .Name
    Item.SentOnBehalfOfEntryID = .EntryID
    Item.SentOnBehalfOfAddressType = .AddressType
    Item.SentOnBehalfOfEmailAddress = .Address
    Item.SentOnBehalfOfSearchKey = .SearchKey
End With

For Each Recipient In Item.Recipients ' Resolve each Recipient's name.
    Recipient.Resolve
Next

On Error Resume Next

        Item.Send

        If Err.Number = MAPI_E_USER_CANCEL Then

            MsgBox "User cancelled the Outlook dialog.  Continuing…"

        ElseIf Err.Number <> 0 Then

            MsgBox Err.Description ' Some other error

        End If

        On Error GoTo 0    ' turns off previous ‘on error resume next’ statement
        
DoCmd.OpenQuery "QryWM02b_Update_Sent", acViewNormal

DoCmd.Close acReport, "rptLoadDetails"

DoCmd.Close acForm, "frmDespatchData"

End If
.MoveNext
Loop
End With
rs.Close
Set mydb = Nothing
Set rs = Nothing
'DoCmd.SetWarnings True
'DoCmd.Close
End Function

Regards

Paul

 

[1DMF]

Cool, glad it gave you enough food for thought to get something working.

however I am sure it could be cleaned up.

- Along with everyone else's, we can all be guilty of messy code, but it is always better to clean it up while you are working on it and it is fresh in your mind.

Coming back to messy code a few months later is more of a headache trying to understand than cleaning it up in the first place ever is!

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[Andrzejek]

Cleanning up:
1. Have you code aligned.
2. Have all Dim statements at the top of your procedure
3. In this line:[tt]
Dim [red]patha, pathT, pathC, pathH, pathS, CustMailTo[/red], CustMailCC As String[/tt]
All red variables are Variants, is that what you wanted?
4. Check if you declared any variables that you do not use anywhere (use [link MZTools.com]MZTools[/url], it is free and very good tool to use)
5. (should be #1) Have [tt]Option Explicit[/tt] at the top of every module (easy set up in your VBA IDE to have it automatically)
6. Where did you declare D, m, and y for those lines:[tt]
D = Format(Now, "dd")
m = Format(Now, "mm")
Y = Format(Now, "yy")[/tt]



Have fun.

---- Andy

 

[Andrzejek]

Also, you may just do this (kill 8 lines of unnecessary code):

[s]Dim ddate As String
Dim D
Dim m
Dim Y

D = Format(Now, "dd")
m = Format(Now, "mm")
Y = Format(Now, "yy")

ddate = D & "-" & m & "-" & Y[/s]

strHead = "Pallet Transfer Details From " & strPlant & _
    " To Wellington Dated " & [blue]Format(Now, "dd-mm-yy")[/blue] & _
    " Load ID_" & strLoadID

strNewName = DLookup("[Path]", _
    "tblWMail_FilePaths", "[Type] = 'E-mail'") & strFilename & "_" & _
    [blue]Format(Now, "dd-mm-yy")[/blue] & "_" & "LoadID_" & strLoadID & ".pdf"

Unless you do like to juggle stuff around

Have fun.

---- Andy