Its been a couple of years since I've done anything with VBA so I'm very rusty. I'm trying to improve some of our existing systems whilst i have some time to do so.
I have code that will produce an invoice from the database, save it on the server and then attach it to an email.
What I want to do now is for the code (where it adds attachments to email) to loop through and do this for all records in the record set (whilst also updating the date it happened so they are not on the future record set).
To be clear, all records in the recordset should be put into one email.
I will show the code that works for individual invoices/records. Ill also show my attempt at making it loop. The issue with the looping is; It will create multiple email windows and not add any attachments. Any ideas or advice would be appreciated.
Working code for individual invoice:
Private Sub Command12_Click()
Dim MyInvoice As String
Dim MyFilename As String
Dim SentFolder As String
Dim FSO As Object
Dim appOutLook As Object
Dim MailOutLook As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
MyFilename = [Invoice_Num] & ".pdf"
MyInvoice = "\\server\finance\invoices\" & Me.Company_Name & "\" & [Order_Number] & "\" & MyFilename
Debug.Print MyOrder
SentFolder = "\\server\finance\invoices\" & Me.Company_Name & "\" & [Order_Number] & "\" & "Sent" & "\" & MyFilename
Debug.Print SentFolder
'---------------------------------------------------CREATE EMAIL -----------------------------------------
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(0) '(
With MailOutLook
.Subject = (Me.Text4) & " - " & (Me.Text10) & " invoice."
'.to = "[email protected]"
.Display
.HTMLBody = "Please see attached invoice for " & (Me.Text4)
.Attachments.Add (MyInvoice)
Dim SourceFileName As String, DestinFileName As String
FSO.MoveFile Source:=MyInvoice, Destination:=SentFolder
End With
Set appOutLook = Nothing
Set MailOutLook = Nothing
'---------------------------------------------------CREATE EMAIL END -----------------------------------------
DoCmd.SetWarnings False
DoCmd.OpenQuery "Update_Sent_Invoice"
DoCmd.SetWarnings True
Me.Refresh
Me.Requery
Forms![Menu].Requery
Forms![Menu].Refresh
Exit Sub
Error_Handle:
MsgBox "Oops, an error has occured." & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.descriptionMy attempt at making it loop:
Private Sub Command13_Click()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "Invoice_To_Be_Sent"
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
Dim MyInvoice As String
Dim MyFilename As String
Dim SentFolder As String
Dim FSO As Object
Dim appOutLook As Object
Dim MailOutLook As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
MyFilename = [Invoice_Num] & ".pdf"
MyInvoice = "\\server\finance\invoices\" & Me.Company_Name & "\" & [Order_Number] & "\" & MyFilename
Debug.Print MyOrder
SentFolder = "\\server\finance\invoices\" & Me.Company_Name & "\" & [Order_Number] & "\" & "Sent" & "\" & MyFilename
Debug.Print SentFolder
'---------------------------------------------------CREATE EMAIL -----------------------------------------
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(0) '(
With MailOutLook
.Subject = (Me.Text4) & " - " & (Me.Text10) & " invoice."
'.to = "[email protected]"
.Display
.HTMLBody = "Please see attached invoice for " & (Me.Text4)
.Attachments.Add (MyInvoice)
Dim SourceFileName As String, DestinFileName As String
FSO.MoveFile Source:=MyInvoice, Destination:=SentFolder
End With
.MoveNext
Wend
End If
.Close
'Make sure you close the recordset...
End With
ExitSub:
Set rs = Nothing
'..and set it to nothing
Exit Sub
ErrorHandler:
Resume ExitSub
Set appOutLook = Nothing
Set MailOutLook = Nothing
'---------------------------------------------------CREATE EMAIL END -----------------------------------------
'DoCmd.SetWarnings False
'DoCmd.OpenQuery "Update_Sent_Invoice"
'DoCmd.SetWarnings True
Me.Refresh
Me.Requery
Forms![Menu].Requery
Forms![Menu].Refresh
Exit Sub
Error_Handle:
MsgBox "Oops, an error has occured." & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.description
End SubI have tried different variations and I'm pretty stuck for ideas at the moment.
