?
Solved

Outlook Insert Image Macro

Posted on 2011-10-27
10
Medium Priority
?
1,398 Views
Last Modified: 2012-05-12
Hello,

I would like to create a macro in Outlook 2003 that allows me to insert an image wherever my cursor is in the body of the email.  The macro should also insert an HTML signature after the image.  So once the macro runs I would like it to insert the following text, image and HTML file:

Regards,
IMAGE (.JPG)
HTML Signature

Is this something that is possible to do in Outlook 2003?

Thanks.
0
Comment
Question by:navid86
  • 6
  • 4
10 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 37040775
Hi, navid86.

That's difficult to do in Outlook 2003 unless you're using Word as your editor.  Why not just use a signature?
0
 
LVL 2

Author Comment

by:navid86
ID: 37044272
Well the HTML file is a signature.  I actually have code that inserts the HTML file, but we also want to insert an image too.  The code below is what I am using to insert the HTML signature.  If its too difficult to make one macro that inserts an image and a signature, then is it possible to just create a macro that inserts an image?
Sub InsertSigAtCursor()
    
'MACRO TO INSERT SIGNATURE AT USERS CURSOR
    
    Dim objFSO As Object, _
        objShell As Object, _
        objSignatureFile As Object, _
        strSigFilePath As String, _
        strBuffer As String
    
    Set olkMsg = Application.ActiveInspector.CurrentItem
    Set objShell = CreateObject("Wscript.Shell")
    
    strSigFilePath = objShell.SpecialFolders("Desktop")
    
    If InStr(1, WinVer(), "Vista") Then
        strSigFilePath = Replace(strSigFilePath, "Desktop", "AppData\Roaming\Microsoft\Signatures\")
    Else
        strSigFilePath = Replace(strSigFilePath, "Desktop", "Application Data\Microsoft\Signatures\")
    End If
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Edit the signature file name on the following line as needed'
    Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "dns-first.jpg")
    
    strBuffer = objSignatureFile.ReadAll
    
    objSignatureFile.Close
    
    PutHTMLClipboard strBuffer, "", ""
    
    Set objSignatureFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    Set olkMsg = Nothing
    
    SendKeys "+{INSERT}"
End Sub

Option Explicit

'THIS MODULE IS FOR THE FUNCTION OF THE INSERTSIGATCURSOR() MACRO

'DECLARE VARIABLES
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpData As Long) As Long

Private Const m_sDescription = _
                  "Version:1.0" & vbCrLf & _
                  "StartHTML:aaaaaaaaaa" & vbCrLf & _
                  "EndHTML:bbbbbbbbbb" & vbCrLf & _
                  "StartFragment:cccccccccc" & vbCrLf & _
                  "EndFragment:dddddddddd" & vbCrLf
                  
Private m_cfHTMLClipFormat As Long

Function RegisterCF() As Long
   
   'REGISTER THE HTML CLIPBOARD FORMAT
   
   If (m_cfHTMLClipFormat = 0) Then
      m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format")
   End If
   
   RegisterCF = m_cfHTMLClipFormat
End Function

Public Sub PutHTMLClipboard(sHtmlFragment As String, Optional sContextStart As String = "<HTML><BODY>", _
   Optional sContextEnd As String = "</BODY></HTML>")
   
   Dim sData As String
   
   If RegisterCF = 0 Then Exit Sub
   
   'Add the starting and ending tags for the HTML fragment
   sContextStart = sContextStart & "<!--StartFragment -->"
   sContextEnd = "<!--EndFragment -->" & sContextEnd
   
   'Build the HTML given the description, the fragment and the context.
   'And, replace the offset place holders in the description with values
   'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment.
   sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd
   sData = Replace(sData, "aaaaaaaaaa", _
                   Format(Len(m_sDescription), "0000000000"))
   sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000"))
   sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _
                   sContextStart), "0000000000"))
   sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _
                   sContextStart & sHtmlFragment), "0000000000"))

   'Add the HTML code to the clipboard
   If CBool(OpenClipboard(0)) Then
   
      Dim hMemHandle As Long, lpData As Long
      
      hMemHandle = GlobalAlloc(0, Len(sData) + 10)
      
      If CBool(hMemHandle) Then
               
         lpData = GlobalLock(hMemHandle)
         If lpData <> 0 Then
            
            CopyMemory ByVal lpData, ByVal sData, Len(sData)
            GlobalUnlock hMemHandle
            EmptyClipboard
            SetClipboardData m_cfHTMLClipFormat, hMemHandle
                        
         End If
      
      End If
   
      Call CloseClipboard
   End If

End Sub

Public Function GetHTMLClipboard() As String

   Dim sData As String
   
   If RegisterCF = 0 Then Exit Function
   
   If CBool(OpenClipboard(0)) Then
   
      Dim hMemHandle As Long, lpData As Long
      Dim nClipSize As Long
      
      GlobalUnlock hMemHandle

      'Retrieve the data from the clipboard
      hMemHandle = GetClipboardData(m_cfHTMLClipFormat)
      
      If CBool(hMemHandle) Then
               
         lpData = GlobalLock(hMemHandle)
         If lpData <> 0 Then
            nClipSize = lstrlen(lpData)
            sData = String(nClipSize + 10, 0)
            

            Call CopyMemory(ByVal sData, ByVal lpData, nClipSize)
            
            Dim nStartFrag As Long, nEndFrag As Long
            Dim nIndx As Long
            
            'If StartFragment appears in the data's description,
            'then retrieve the offset specified in the description
            'for the start of the fragment. Likewise, if EndFragment
            'appears in the description, then retrieve the
            'corresponding offset.
            nIndx = InStr(sData, "StartFragment:")
            If nIndx Then
               nStartFrag = CLng(Mid(sData, _
                                 nIndx + Len("StartFragment:"), 10))

            End If
            nIndx = InStr(sData, "EndFragment:")
            If nIndx Then
               nEndFrag = CLng(Mid(sData, nIndx + Len("EndFragment:"), 10))
            End If
            
            'Return the fragment given the starting and ending
            'offsets
            If (nStartFrag > 0 And nEndFrag > 0) Then
               GetHTMLClipboard = Mid(sData, nStartFrag + 1, _
                                 (nEndFrag - nStartFrag))
            End If
                        
         End If
      
      End If

   
      Call CloseClipboard
   End If


End Function

Open in new window

0
 
LVL 2

Author Comment

by:navid86
ID: 37044279
The Sub InsertSigAtCursor is wrong above.  Here is the correct subroutine.
Sub InsertSigAtCursor()
    
'MACRO TO INSERT SIGNATURE AT USERS CURSOR
    
    Dim objFSO As Object, _
        objShell As Object, _
        objSignatureFile As Object, _
        strSigFilePath As String, _
        strBuffer As String
    
    Set olkMsg = Application.ActiveInspector.CurrentItem
    Set objShell = CreateObject("Wscript.Shell")
    
    strSigFilePath = objShell.SpecialFolders("Desktop")
    
    If InStr(1, WinVer(), "Vista") Then
        strSigFilePath = Replace(strSigFilePath, "Desktop", "AppData\Roaming\Microsoft\Signatures\")
    Else
        strSigFilePath = Replace(strSigFilePath, "Desktop", "Application Data\Microsoft\Signatures\")
    End If
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Edit the signature file name on the following line as needed'
    Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "DNS-FIRM.htm")
    
    strBuffer = objSignatureFile.ReadAll
    
    objSignatureFile.Close
    
    PutHTMLClipboard strBuffer, "", ""
    
    Set objSignatureFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    Set olkMsg = Nothing
    
    SendKeys "+{INSERT}"
End Sub

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 76

Expert Comment

by:David Lee
ID: 37061754
Is the image part of the signature, or is the image separate?  If it's separate, then does it need to be separate for some reason?
0
 
LVL 2

Author Comment

by:navid86
ID: 37064364
Yes, the image is separate from the HTML signature.  It does need to be separate so the user can insert it if he/she likes.  Because the HTML signature does not go hand and hand with the image, some of my users prefer using the image with or without the html signature.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 37082141
Ok.  The issue really is how to get the image onto the clipboard so it can then be pasted into the message via SendKeys.  I don't have Outlook 2003 anymore, so I'm not in a position to test this with that version of Outlook.  I have tested what I'm going to propose in Outlook 2007 and it works fine.  Here''s what you need to do.

1.  Go to this page, copy the code, and add it to an Outlook module.
2.  Place the image in question on a web server.
3.  Add the code below.
4.  Create a new message.  Position the cursor where you want the image to be inserted.  Run the macro.  I think it'll be best if you add the macro to the toolbar so you can run it with a click.


Sub InsertImageFromClipboard()
    'Edit the URL to the image on the next line
    PutHTMLClipboard "<img src=""http://server.company.com/ImageName.JPG"" />"
    SendKeys "+{INSERT}", True
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:navid86
ID: 37085422
It works great!  Just one last question, is the size and properties of the image defined in the HTML?  Because it seems like no matter how small i make the image, when I run the macro to insert it and it always inserts at the same size, and not its original size.  
0
 
LVL 2

Author Comment

by:navid86
ID: 37085726
After further analysis I see that the image actually needs to be resized via HTML.  So when I try to put in the resize code I got the below error message:

Compile error:  Expected end of statement (highlights "width" as the problem code)

PutHTMLClipboard "<img src=""http://server.company.com/ImageName.JPG" width="160" height="50"" />"

Open in new window

0
 
LVL 76

Assisted Solution

by:David Lee
David Lee earned 2000 total points
ID: 37086558
Each set of double-quotes inside the outer pair of double-quotes have to be doubled (i.e. "").
PutHTMLClipboard "<img src=""http://server.company.com/ImageName.JPG"" width=""160"" height=""50"" />"

Open in new window

0
 
LVL 2

Author Closing Comment

by:navid86
ID: 37093727
Perfect Solutions, works great!
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
With so many activities to perform, Exchange administrators are always busy in organizations. If everything, including Exchange Servers, Outlook clients, and Office 365 accounts work without any issues, they can sit and relax. But unfortunately, it…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…
Suggested Courses

862 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