How to add a signature to a template

[greaseman]

Does anyone know how to add a signature to an Outlook template - not my own signature, but someone elses? I am trying to write a project in Access 2007 and use Outlook 2007 to write e-mails to a group of students at my college, but using the signatures of our department heads. I have tables that contain the designated students and another one that contains the department head signatures.

If I can't attach the signatures to the Outlook template, is there a way to attach the signatures to the body of the e-mail instead?

I've got my project working.... it's just this signature piece that is giving me fits.

Here is my code....

Option Compare Database
Option Explicit
Global bProcessed As Boolean

Sub sEmail()

Dim db              As Database
Dim rsStudents      As Recordset
Dim sStudents       As String
Dim rsCounselors    As Recordset
Dim sCounselors     As String
Dim sBCC            As String
Dim sSender         As String
Dim lCnt1           As Integer
Dim lCnt2           As Integer
Dim iStudentCnt     As Integer
Dim iCounselorCnt   As Integer
Dim iDivisionCnt As Integer
Dim sSubject        As String
Dim sWarning        As String
Dim bTestRun        As Boolean
Dim lProcessed      As Integer
Dim iRtn            As Integer

Set db = CurrentDb()

'****SET bTestRun TO 'FALSE", TO RUN THE ACTUAL BULK E-MAIL
'****SET bTestRun TO 'TRUE', TO RUN THE TEST BULK E-MAIL
bTestRun = False
    
Stop
'**********************************************************************************
'**   Open the database tables
'**********************************************************************************
'
sStudents = "Select * from Students;"
Set rsStudents = db.OpenRecordset(sStudents)

sCounselors = "Select * from Counselors;"
Set rsCounselors = db.OpenRecordset(sCounselors)

'**********************************************************************************
'**   Set the counters equal to the record counts of the tables
'**********************************************************************************
'
rsStudents.MoveLast
iStudentCnt = rsStudents.RecordCount
rsStudents.MoveFirst
rsCounselors.MoveLast
iCounselorCnt = rsCounselors.RecordCount
rsCounselors.MoveFirst
iDivisionCnt = iStudentCnt / iCounselorCnt

'**********************************************************************************
'**   Set up the Subject of the E_Mail that's going to get sent
'**********************************************************************************
'
sSubject = "This is a test of stuff for my college"

'**********************************************************************************
'**   Set up the Blind Copy of the E_Mail that's going to get sent
'**********************************************************************************
'
sBCC = "ralphie@my.test.edu;janedoe@my.test.edu;guineapig@my.test.edu"

If bTestRun = True Then
    Call SendEMailMessage(sSubject, sBCC, sSender, bTestRun)
Else
    sBCC = ""
        Do Until rsStudents.EOF
            Do Until lCnt1 = iDivisionCnt Or rsStudents.EOF
                If lCnt1 = 0 Then
                    sBCC = rsStudents("E_Mail")
                    sSender = rsCounselors("CounselMail")
                Else
                    sBCC = sBCC & ";" & rsStudents("E_Mail")
                    sSender = rsCounselors("CounselMail")
                End If
                lCnt1 = lCnt1 + 1
                rsStudents.MoveNext
                DoEvents
            Loop
        Call SendEMailMessage(sSubject, sBCC, sSender, bTestRun)
        sBCC = ""
        lProcessed = lProcessed + lCnt1
        iRtn = SysCmd(acSysCmdSetStatus, "Records Processed: " & lProcessed)
        lCnt1 = 0
        rsCounselors.MoveNext
        If rsCounselors.EOF Then GoTo theend
         Loop

End If
theend:
End Sub

Sub SendEMailMessage(psSubject As String, psBCC As String, psSender As String, pbTest As Boolean)

Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
'Dim vbaLetter As Application

Dim sSql As String
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb

sSql = "Select * from tblMessage;"

Set rs = db.OpenRecordset(sSql)

sMessage = rs("EmailMessage")

On Error Resume Next

'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    'Outlook wasn't running, start it from code
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If

'Create a new mailitem
'Set oItem = oOutlookApp.CreateItem(olMailItem)
Set oItem = oOutlookApp.CreateItemFromTemplate("C:\MSACCESSSTUFF\Counselors.oft")

With oItem

     'set BCC
    .BCC = psBCC
    'Set the subject
    .Subject = psSubject
    'Enter HTML
'    .HTMLBody = sMessage
     .SentOnBehalfOfName = psSender
    '.BodyFormat = olFormatHTML
    '.Body = sMessage
    'request read receipt
    '.ReadReceiptRequested = True
    'set importance flag
    .Importance = olImportanceHigh
    'display email before sending
    .Send
    
End With

If bStarted Then
    'If we started Outlook from code, then close it
    oOutlookApp.Quit
End If

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing

End Sub

Thank you so much for taking the time to read my questions and for further taking the time to reply.