admin管理员组

文章数量:1291127

When I execute the VBA code the signature shows up but I get an error with the company logo saying that it can not be displayed.

The goal is for whomever hits the generate email button that it adds their personal Outlook signature which includes company logo and possibly a gif as well.

I tried various ways to fix it but it ends up breaking or messing up the email completely.

Here is code for example:

Sub send_email_with_table_as_Pic_1()

    Dim outapp As Object
    Dim outmail As Object
    Dim table As Range
    Dim ws As Worksheet
    Dim pic As Object
    Dim worddoc As Object
    Dim imgShape As Object
    Dim currentDate As String
    Dim generatedTime As String
    Dim FSO As Object
    Dim SigFile As Object
    Dim Signature As String
    Dim sigPath As String
    Dim enviro As String
    
    ' Capture the current date
    currentDate = Format(Date, "mm/dd/yyyy")
    
    ' Capture the current time in "hh:mm AM/PM CST" format
    generatedTime = GetCSTTime()
    
    ' Create Outlook application
    Set outapp = CreateObject("Outlook.Application")
    Set outmail = outapp.CreateItem(0)

    ' Get the sender's signature path
    enviro = Environ("appdata") ' Fetch user AppData path
    sigPath = enviro & "\Microsoft\Signatures\"

    ' Check for HTML signature
    If Dir(sigPath, vbDirectory) <> "" Then
        If Dir(sigPath & "*.htm") <> "" Then
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set SigFile = FSO.OpenTextFile(sigPath & Dir(sigPath & "*.htm"), 1)
            Signature = SigFile.ReadAll
            SigFile.Close
        Else
            Signature = "" ' No signature found
        End If
    Else
        Signature = ""
    End If

    ' Set reference to the worksheet and range
    Set ws = ThisWorkbook.Sheets("Metrics")
    Set table = ws.Range("C2:U64")
    
    ' Copy the table as a picture
    table.CopyPicture xlScreen, xlPicture
    
    ' Create the email
    With outmail
        .SentOnBehalfOfName = "[email protected]"
        .To = "[email protected]; [email protected]"
        .Subject = "Mid-Day Performance Metrics Report " & currentDate
        .Display
        
        ' Add the image to the email body via Word Editor
        Set worddoc = outmail.GetInspector.WordEditor
        worddoc.Range.Paste
        
        ' Adjust the image size
        Set imgShape = worddoc.InlineShapes(worddoc.InlineShapes.Count)
        imgShape.LockAspectRatio = False
        imgShape.Height = 12.5 * 72
        imgShape.Width = 18 * 72

        ' Add text after the image
        With worddoc.Range
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Please let us know if you have any questions or concerns."
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Thank you,"
        End With

        ' Add HTML body content and append the sender's signature
        .htmlBody = "<body style='font-size:11pt; font-family:Calibri'>" & _
                    "Good Afternoon,<p> Below is the Performance Mid-Day report as of <b>" & generatedTime & "</b>.</p><br>" & _
                    .htmlBody & _
                    "<br><br>" & Signature ' Append signature at the end
    End With

    ' Clean up
    Set outapp = Nothing
    Set outmail = Nothing
    Set pic = Nothing
    Set FSO = Nothing
    Set SigFile = Nothing

End Sub

When I execute the VBA code the signature shows up but I get an error with the company logo saying that it can not be displayed.

The goal is for whomever hits the generate email button that it adds their personal Outlook signature which includes company logo and possibly a gif as well.

I tried various ways to fix it but it ends up breaking or messing up the email completely.

Here is code for example:

Sub send_email_with_table_as_Pic_1()

    Dim outapp As Object
    Dim outmail As Object
    Dim table As Range
    Dim ws As Worksheet
    Dim pic As Object
    Dim worddoc As Object
    Dim imgShape As Object
    Dim currentDate As String
    Dim generatedTime As String
    Dim FSO As Object
    Dim SigFile As Object
    Dim Signature As String
    Dim sigPath As String
    Dim enviro As String
    
    ' Capture the current date
    currentDate = Format(Date, "mm/dd/yyyy")
    
    ' Capture the current time in "hh:mm AM/PM CST" format
    generatedTime = GetCSTTime()
    
    ' Create Outlook application
    Set outapp = CreateObject("Outlook.Application")
    Set outmail = outapp.CreateItem(0)

    ' Get the sender's signature path
    enviro = Environ("appdata") ' Fetch user AppData path
    sigPath = enviro & "\Microsoft\Signatures\"

    ' Check for HTML signature
    If Dir(sigPath, vbDirectory) <> "" Then
        If Dir(sigPath & "*.htm") <> "" Then
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set SigFile = FSO.OpenTextFile(sigPath & Dir(sigPath & "*.htm"), 1)
            Signature = SigFile.ReadAll
            SigFile.Close
        Else
            Signature = "" ' No signature found
        End If
    Else
        Signature = ""
    End If

    ' Set reference to the worksheet and range
    Set ws = ThisWorkbook.Sheets("Metrics")
    Set table = ws.Range("C2:U64")
    
    ' Copy the table as a picture
    table.CopyPicture xlScreen, xlPicture
    
    ' Create the email
    With outmail
        .SentOnBehalfOfName = "[email protected]"
        .To = "[email protected]; [email protected]"
        .Subject = "Mid-Day Performance Metrics Report " & currentDate
        .Display
        
        ' Add the image to the email body via Word Editor
        Set worddoc = outmail.GetInspector.WordEditor
        worddoc.Range.Paste
        
        ' Adjust the image size
        Set imgShape = worddoc.InlineShapes(worddoc.InlineShapes.Count)
        imgShape.LockAspectRatio = False
        imgShape.Height = 12.5 * 72
        imgShape.Width = 18 * 72

        ' Add text after the image
        With worddoc.Range
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Please let us know if you have any questions or concerns."
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Thank you,"
        End With

        ' Add HTML body content and append the sender's signature
        .htmlBody = "<body style='font-size:11pt; font-family:Calibri'>" & _
                    "Good Afternoon,<p> Below is the Performance Mid-Day report as of <b>" & generatedTime & "</b>.</p><br>" & _
                    .htmlBody & _
                    "<br><br>" & Signature ' Append signature at the end
    End With

    ' Clean up
    Set outapp = Nothing
    Set outmail = Nothing
    Set pic = Nothing
    Set FSO = Nothing
    Set SigFile = Nothing

End Sub
Share Improve this question edited Feb 24 at 14:56 CommunityBot 11 silver badge asked Feb 14 at 2:30 Marcus BonillaMarcus Bonilla 12 bronze badges 4
  • 1 Please edit your question to add the complete, exact error message that you're getting. – Ken White Commented Feb 14 at 2:52
  • Without seeing your error message it's going to be very hard to respond on this one - but you might want to check the html file and ensure the full path of the logo is used, not the 'local' path. – CLR Commented Feb 14 at 10:44
  • Please include an example of the type of content read into Signature (suitably redacted but including all of the elements) Does the image not display for the sender or the recipient, or is it only the recipient where it's missing? – Tim Williams Commented Feb 14 at 16:05
  • See stackoverflow/questions/76672633/… – CDP1802 Commented Feb 15 at 21:47
Add a comment  | 

1 Answer 1

Reset to default 0

Another way to get the default signature is to create a new email and store the body in a temporary variable

Check this thread for more info: How to add default signature in Outlook

本文标签: excelDisplay company logo in my personal Outlook signatureStack Overflow