Hi Dave,
Can you try this?
Code:
Dim myEmail as String, FullName() as string
Dim PDFPath as string, PDFFile as string
Dim HolReqPath as string, HolReqFile as string
Dim sSubject as string,sHTMLBody as string
Set rs = CurrentDb.OpenRecordset("Select * From tblStaff")
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst
Do Until rs.EOF = True
myEmail = rs.Fields("Email")
FullName = Split(rs.Fields("Name"), " ")
Select Case UBound(FullName)
Case 0
fName = FullName(0)
Case 1
fName = FullName(0)
Case 2
fName = FullName(0) & " " & FullName(2)
End Select
a = TOD & " " & fName & ","
b = "We are now going to be sending you an updated Holiday Calendar and a copy of a holiday request form, 'only when changes have been made to the calendar' which you will also find on the notice board in the warehouse, this gives you the opportunity to plan any holidays from home."
c = "If you wish to start planning your holidays from your annual allowance, please note any days that are highlighted in yellow are already taken and are NOT available."
d = "Please note: we will endeavour to allocate your requested days unless days that you are requesting are already taken."
e = "Kind Regards"
'Set OutAccount = oEmailItem.Session.Accounts.Item(1)
'With oEmailItem
'.To = rs.Fields("Email")
'.Attachments.Add PDFPath & PDFFile 'PDFPAth must end in \
'.Attachments.Add HolReqPath & HolReqFile
sSubject = "Holiday Calendar " & Format(Now(), "yyyy") & " Update"
sHTMLBody = a & "<br>" & "<br>" & b & "<br>" & "<br>" & c & "<br>" & "<br> " & _
d & "<br>" & "<br>" & e & "<br>" & "<br>" & _
"<P><IMG border=0 hspace=0 alt='' src='file://T:/CompanyName/Logo Media/Email Signature.jpg' align=baseline></P>" & "<br>" & "<br>" & _
"<FONT color=#00008B>" & eDisc & "<br>" & "<FONT color =#00008B>" & eDisc2
'.SendUsingAccount = OutAccount
'.Display
'End With
dmtSendEmail_Outlook(sSubject,myEmail,,PDFPath & PDFFile & "|" & HolReqPath & HolReqFile,sHTMLBody
rs.MoveNext
Loop
Public Function dmtSendEmail_Outlook(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim OutAccount as Object
Dim sAttachments() as string,i as integer
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutAccount = oEmailItem.Session.Accounts.Item(1)
Set OutMail = OutApp.CreateItem(0)
OutMail.SendUsingAccount = OutAccount
OutMail.To = sTo
If sCC <> "" Then OutMail.CC = sCC
If sBcc <> "" Then OutMail.BCC = sBcc
OutMail.Subject = sSubject
OutMail.HTMLBody = sBody
sAttachments=Split (sAttachment,"|")
For i=0 to UBound(sAttachments)
OutMail.Attachments.Add (sAttachments(i))
Next i
OutMail.Send 'Send | Display
Set OutMail = Nothing
End Function
Set oEmailItem = oOutlook.CreateItem(olMailItem)