Results 1 to 2 of 2

Thread: Modify the VBA code to exclude text only leave logo from signature

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #2
    Junior Member
    Join Date
    Nov 2017
    Posts
    21
    Rep Power
    0
    I found this code below in the internet, this one you can see that it can pick up range with its image, i tried using the technique below into the above code, but i failed. I appreciate your help.

    Code:
    Private Function RngToEmail(rng As Range, eTo As String, eSubject As String)
        Dim wbThis As Workbook, wbNew As Workbook
        Dim tempFileName As String, imgName As String, newPath As String
    
        '~~> Do not change "Myimg". This will be used to
        '~~> identify the images
        Dim imgPrefix As String: imgPrefix = "Myimg"
    
        '~~> This is the temp html file name.
        '~~> Do not change this as when you publish the
        '~~> html file, it will create a folder Temp_files
        '~~> to store the images
        Dim tmpFile As String: tmpFile = "Temp.Htm"
    
        Set wbThis = Workbooks(rng.Parent.Parent.Name)
        Set wbNew = Workbooks.Add
    
        '~~> Copy the relevant range to new workbook
        rng.Copy wbNew.Worksheets("Sheet1").Range("A1")
    
        newPath = wbThis.Path & "\"
        tempFileName = newPath & tmpFile
    
        '~~> Publish the image
        With wbNew.PublishObjects.Add(xlSourceRange, _
            tempFileName, "Sheet1", rng.Address, xlHtmlStatic, _
            imgPrefix, "")
            .Publish (True)
            .AutoRepublish = True
        End With
    
        '~~> Close the new file without saving
        wbNew.Close (False)
    
        '~~> Read the html file in a string in one go
        Dim MyData As String, strData() As String
        Dim i As Long
        Open tempFileName For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        strData() = Split(MyData, vbCrLf)
    
        '~~> Loop through the file
        For i = LBound(strData) To UBound(strData)
            '~~> Here we will first get the image names
            If InStr(1, strData(i), "Myimg_", vbTextCompare) And InStr(1, strData(i), ".Png", vbTextCompare) Then
                '~~> Insert actual path to the images
                strData(i) = Replace(strData(i), "Temp_files/", newPath & "Temp_files\")
            End If
        Next i
    
        '~~> Rejoin to get the new html string
        MyData = Join(strData, vbCrLf)
    
        '~~> Create the Email
        Dim OutApp As Object, OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        With OutMail
            .To = eTo
            .Subject = eSubject
    
            '~~> Set the body
            .HTMLBody = MyData
    
            '~~> Show the email. Change it to `.Send` to send it
            .Display
        End With
    
        '~~> Delete the temp file name
        Kill tempFileName
    End Function
    Last edited by flora; 09-02-2019 at 09:20 PM.

Similar Threads

  1. Add Digital Signature To PDF Using VBA
    By in.vaibhav in forum Excel Help
    Replies: 5
    Last Post: 08-16-2024, 09:56 PM
  2. Replies: 3
    Last Post: 06-07-2017, 05:27 PM
  3. Need help to modify the VBA code
    By jeremiah_j2k in forum Excel Help
    Replies: 8
    Last Post: 10-23-2014, 01:44 PM
  4. Try to modify printer defaults from access-vba
    By relui in forum Access Help
    Replies: 0
    Last Post: 10-24-2013, 02:56 PM
  5. Council to modify code
    By PcMax in forum Excel Help
    Replies: 4
    Last Post: 02-05-2012, 11:03 PM

Posting Permissions

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