access email signature not working

Dear experts - we are using the procedure below to send emails.
It HAD been working fine, but now the default signature is not appearing. Perhaps this is due to upgrading our OS - for example, I don't see the c: directory referenced in the code.
Is there a simple programmatic way to use the default signature using this procedure? Failing that, do you have a procedure that does the same thing that doesn't have this problem?
I am currently using Windows 7 and running Access 2010, but we have users on earlier OS's, I believe, some using Access 2007.
Many thanks in advance.

Sub SendMessage(DisplayMsg As Boolean, SendTo As String, Optional Subject As String, Optional Body As String, Optional AttachmentPath As String, Optional SaveMsg As Boolean, Optional SavePath As String)

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objMessage As Object
Dim FileStr As String
Dim arRecipients As Variant
Dim I As Long
Dim blnSave As Boolean
Dim sSignatureFile As String
Dim iHandle As Integer
Dim sLine As String
Dim htmlstring As String

'Send using Outlook
On Error GoTo SendError

' Create the Outlook session and message
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
    ' Add the To recipient(s) to the message.
    If InStr(SendTo, ";") <> 0 Or InStr(SendTo, ",") <> 0 Then
        arRecipients = Split(Replace(SendTo, ";", ","), ",")
        For I = 0 To UBound(arRecipients)
            Set objOutlookRecip = .Recipients.Add(arRecipients(I))
            objOutlookRecip.Type = olTo
        Next
    Else
        Set objOutlookRecip = .Recipients.Add(SendTo)
        objOutlookRecip.Type = olTo
    End If

    ' Set the Subject, Body, and Importance of the message.
    If Not IsMissing(Subject) Then .Subject = Subject
    
    If Not IsMissing(Body) Then
        .BodyFormat = olFormatHTML

        'Default signature
        sSignatureFile = "C:\Documents and Settings\" & Environ("Username") & "\Application Data\Microsoft\Signatures\New Messages.htm"

        If Dir$(sSignatureFile) <> "" Then

            iHandle = FreeFile
            Open sSignatureFile For Input As #iHandle
            Do While Not EOF(iHandle)
                Line Input #iHandle, sLine
                htmlstring = htmlstring & sLine
            Loop
            Close #iHandle
        End If
   
            .HTMLBody = Replace(.HTMLBody, "<BODY>", "<BODY>" & Body & vbCrLf & vbCrLf & htmlstring)
    End If

    ' Add attachments to the message.
    If Not IsMissing(AttachmentPath) Then
        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
    End If

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

    ' Should we display the message before sending?
    If DisplayMsg Then
'        Debug.Print .HTMLBody
        .display
    Else
        If Not SaveMsg = False Then
            KillFile SavePath
            .SaveAs SavePath
            .Delete
       Else
            .Save
            .Send
SendResume:
        End If
    End If
End With
Set objOutlook = Nothing

Exit Sub
        
SendError:
If Err.Description = "Outlook does not recognize one or more names. " Then
    For I = 1 To objOutlookMsg.Recipients.Count
        objOutlookMsg.Recipients.Remove I
    Next
    Set objOutlookRecip = objOutlookMsg.Recipients.Add(ReadGlobal("DefaultEmail"))
    objOutlookRecip.Type = olTo
    objOutlookMsg.Subject = "REJECTED EMAIL ADDRESS: " & objOutlookMsg.Subject
    objOutlookMsg.Send
    Resume SendResume
Else
    MsgBox Err.Number & " " & Err.Description
End If
Exit Sub

End Sub

Open in new window

terpsichoreAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Zaheer IqbalTechnical Assurance & ImplementationCommented:
The code will need to be adjusted to meet the windows 7 requirements.

Windows 7 holds user profile under c:\user\username where windows xp was c:\documents and settimgs.
0
Zaheer IqbalTechnical Assurance & ImplementationCommented:
0
terpsichoreAuthor Commented:
Could I trouble you to suggest some code to check which version of Office is being used and then to look in that directory? Then I think I'm there...
THANKS
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Zaheer IqbalTechnical Assurance & ImplementationCommented:
Something like this

Function CheckOLVersion()

   Dim dblVersion
   Dim objTestItem

   ' Create a temporary mail message
   Set objTestItem = Application.CreateItem(0)

   ' Save the message so the OutlookVersion property is set.
   objTestItem.Save

   ' Obtain the version of Outlook
   dblVersion = CDbl(objTestItem.OutlookVersion)

   ' Set the function value accordingly.
   ' (You can't use comparison operators with Select Case in VBScript)
   If dblVersion < 8.5 Then
      CheckOLVersion = "97"
   ElseIf dblVersion < 9 Then
      CheckOLVersion = "98"
   ElseIf dblVersion < 10 Then
      CheckOLVersion = "2000"
   Else
      CheckOLVersion = "2002"
   End If

   ' Delete the temporary mail message
   objTestItem.Delete

   Set objTestItem = Nothing

End Function
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
terpsichoreAuthor Commented:
Many thanks - you have given me all the pieces of the puzzle.
0
Zaheer IqbalTechnical Assurance & ImplementationCommented:
No problems enjoy..
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.