I was a little surprised at the simple output from all that coding but it did help me understand it. There was a function missing from the code that dealt with the GetBoiler but I was able to find it online and add it to make the signature code work.
On that subject... my signature displays all but one detail. There is a linked image in the sig that won't display. I have attached screenshots to show what I mean.
The signature in the generated email:
What the signature should look like:
Below is the code for my email... do you know what needs to be added to the signature part to make that linked image show?
Code:
Option Compare Database
Option Explicit
Public Function EmailNotice()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim rst As DAO.Recordset, rst2 As DAO.Recordset, rst3 As DAO.Recordset, rst4 As DAO.Recordset
Dim strAppdata As String, strSigPath As String, strSignature As String
Dim strEMailTo As String, strEMailCC As String, strBody As String
Dim intBody As Integer
Dim varUSMParts As Variant, varAIMParts As Variant
' Get appdata path
strAppdata = Environ("Appdata")
' Set paths
strSigPath = strAppdata & "\Microsoft\Signatures\Primary.htm"
'Get the signature if it exists
If Dir(strSigPath) <> "" Then
strSignature = GetBoiler(strSigPath)
End If
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set rst = CurrentDb.OpenRecordset("select EmailAddress from tbl_users where AccessLvl in (2, 3, 4) ")
rst.MoveFirst
Do While Not rst.EOF
strEMailTo = strEMailTo & "; " & rst!EmailAddress
rst.MoveNext
Loop
Set rst2 = CurrentDb.OpenRecordset("select EmailAddress from tbl_receivers where Active = True ")
rst2.MoveFirst
Do While Not rst2.EOF
strEMailCC = strEMailCC & "; " & rst2!EmailAddress
rst2.MoveNext
Loop
Set rst3 = CurrentDb.OpenRecordset("select PartNumber from tbl_parts where USMonthly = True ")
rst3.MoveFirst
Do While Not rst3.EOF
varUSMParts = varUSMParts & rst3!PartNumber & ", "
rst3.MoveNext
Loop
Set rst4 = CurrentDb.OpenRecordset("select PartNumber from tbl_parts where AIMonthly = True ")
rst4.MoveFirst
Do While Not rst4.EOF
varAIMParts = varAIMParts & rst4!PartNumber & ", "
rst4.MoveNext
Loop
strBody = "<font face=Calibri>Attention all," & "<br><br>" & _
"This email is to alert you that it is time to perform the monthly electrical parts audit." & "<br><br>" & _
"Receivers, please pull the newest P.O. of electrical parts to be audited and contact the auditor with part numbers and their P.O. quantities." & "<br><br>" & _
"USA Receivers, the part numbers that need to be included are listed below. If all are not on one P.O. then pull as many P.O.'s as necessary to complete the list." & "<br>" & _
varUSMParts & "<br><br>" & _
"Aisia Receivers, the part numbers that need to be included are listed below. If all are not on one P.O. then pull as many P.O.'s as necessary to complete the list." & "<br>" & _
varAIMParts & "<br><br>" & _
"Auditors, you will need to coordinate with your receivers to have these parts delivered to you for auditing." & "<br><br>" & _
"Thank you everyone for all of your efforts!</font>" & "<br><br><br>" & strSignature
With MailOutLook
.To = strEMailTo
.BodyFormat = olFormatRichText
.CC = strEMailCC
.Subject = "Monthly Electrical Audit Alert - " & Date
.HTMLBody = strBody
' .Send
.Display 'Used during testing without sending (Comment out .Send if using this line)
End With
End Function
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End FunctionAttachments
Last edited:
