+ Reply to Thread
Results 1 to 2 of 2

Mail Signature Script Error

Hybrid View

tigerdel Mail Signature Script Error 08-20-2012, 07:34 PM
Cutter Re: Mail Signature Script... 08-20-2012, 09:19 PM
  1. #1
    Registered User
    Join Date
    08-19-2012
    Location
    London, England
    MS-Off Ver
    Excel 2016 in Win 10
    Posts
    97

    Mail Signature Script Error

    Hi

    I am trying to add a signature to an email created by a Macro in Excel 2010 but I simply cannot get it to work

    Can anyone help?

    Here is the script I have written

    Sub EmailIndRep()
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim SigString As String
        Dim Signature As String
        Set rng = Nothing
        On Error Resume Next
        Set rng = Sheets("Report").Range("A1:B15").SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If rng Is Nothing Then
            MsgBox "The selection is not a range or the sheet is protected" & _
                   vbNewLine & "please correct and try again.", vbOKOnly
            Exit Sub
        End If
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        strbody = "<H3><B>Dear Customer</B></H3>" & _
                  "Please visit this website to download the new version.<br>" & _
                  "Let me know if you have problems.<br>" & _
                  "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
                  "<br><br><B>Thank you</B>"
        SigString = Environ("appdata") & _
         src = "Signatures/icapital.htm"
         src = "icapital_files/image001.png"
         src = "icapital_files/image002.png"
         src = "icapital_files/image003.png"
        If Dir(SigString) <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
        End If
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "Your Annual Leave Summary"
            .HTMLBody = strbody & RangetoHTML(rng) & "<br><br>" & Signature
            .Display
        End With
        On Error GoTo 0
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub
    Function RangetoHTML(rng As Range)
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook
        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
        rng.Copy
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        End With
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
        End With
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.readall
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
        TempWB.Close savechanges:=False
        Kill TempFile
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    Any help here is most welcome

    Thanks
    Last edited by Cutter; 08-20-2012 at 09:18 PM. Reason: Added code tags

  2. #2
    Forum Expert Cutter's Avatar
    Join Date
    05-24-2004
    Location
    Ontario,Canada
    MS-Off Ver
    Excel 2010
    Posts
    6,451

    Re: Mail Signature Script Error

    @ tigerdel

    Welcome to the forum.

    Please notice that code tags have been added to your post(s). The forum rules require them so please keep that in mind and add them yourself whenever showing code in any of your future posts. To see instructions for applying them, click on the Forum Rules button at top of the page and read Rule #3.
    Thanks.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1