access email signature not working

Posted on 2013-10-08
Medium Priority
Last Modified: 2013-10-08
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
        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
            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

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

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

End Sub

Open in new window

Question by:terpsichore
  • 4
  • 2
LVL 20

Expert Comment

by:Zaheer Iqbal
ID: 39554809
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.
LVL 20

Expert Comment

by:Zaheer Iqbal
ID: 39554811

Author Comment

ID: 39554849
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...
Easily Design & Build Your Next Website

Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.

LVL 20

Accepted Solution

Zaheer Iqbal earned 2000 total points
ID: 39555082
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.

   ' 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"
      CheckOLVersion = "2002"
   End If

   ' Delete the temporary mail message

   Set objTestItem = Nothing

End Function

Author Closing Comment

ID: 39555089
Many thanks - you have given me all the pieces of the puzzle.
LVL 20

Expert Comment

by:Zaheer Iqbal
ID: 39555113
No problems enjoy..

Featured Post

Train for your Pen Testing Engineer Certification

Enroll today in this bundle of courses to gain experience in the logistics of pen testing, Linux fundamentals, vulnerability assessments, detecting live systems, and more! This series, valued at $3,000, is free for Premium members, Team Accounts, and Qualified Experts.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
A quick solution showing how to control and open a POS Cash Register Drawer using VBA with MS Access.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

623 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question