asked on

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

Zaheer Iqbal

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.

Zaheer Iqbal

Outlook 2010 file location - http://office.microsoft.com/en-us/outlook-help/where-does-microsoft-outlook-2010-save-my-information-and-configurations-HP010354943.aspx

terpsichore

ASKER

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

ASKER CERTIFIED SOLUTION

Zaheer Iqbal

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

terpsichore

ASKER

Many thanks - you have given me all the pieces of the puzzle.

Zaheer Iqbal

No problems enjoy..