Do you want to export all the image attachments of an email to a Word document? If you have this requirement, you can refer to this article. Here we’ll teach you how to intelligently realize it step by step.
My previous article “How to Quickly Export All Image Attachments of an Outlook Email to a PDF File” has introduced how to export image attachments to a PDF. However, it is difficult to edit a PDF. Thus, if what you would like to do is to make use of the image attachments to compose an editable Word document, you could read on to get a method.
Export All Image Attachments of an Email to a Word Document
- At the very outset, start your Outlook program.
- Then, after accessing Outlook, open the VBA editor window by following the steps shown in the article – “How to Run VBA Code in Your Outlook”.
- Next, enable “Microsoft Word Object Library” with reference to “How to Add an Object Library Reference in VBA”.
- Subsequently, put the piece of VBA code below into an empty module.
Sub ExportAllImageAttachmentsIntoWordDocument() Dim objSourceMail As Outlook.MailItem Dim objAttachment As Outlook.Attachment Dim objWordApp As Word.Application Dim objTempDocument As Word.Document Dim strImage As String Dim objInlineShape As Word.InlineShape Dim strPDF As String Set objSourceMail = Application.ActiveInspector.CurrentItem If Not (objSourceMail Is Nothing) Then Set objWordApp = CreateObject("Word.Application") Set objTempDocument = objWordApp.Documents.Add objWordApp.Visible = True objTempDocument.Activate strTempFolder = Environ("Temp") & "\" & Format(Now, "yyyymmddhhmmss") & "\" MkDir (strTempFolder) Set objFileSystem = CreateObject("Scripting.FileSystemObject") For Each objAttachment In objSourceMail.Attachments If IsEmbedded(objAttachment) = False Then Select Case LCase(objFileSystem.GetExtensionName(objAttachment.FileName)) Case "jpg", "jpeg", "png", "bmp", "gif" objAttachment.SaveAsFile strTempFolder & objAttachment.FileName End Select End If Next strImage = Dir(strTempFolder & "*.*", vbNormal) Do Until Len(strImage) = 0 With Selection .InlineShapes.AddPicture (strTempFolder & strImage) .TypeParagraph .Collapse Direction:=wdCollapsEnd .ParagraphFormat.Alignment = wdAlignParagraphCenter .TypeParagraph End With strImage = Dir() Loop For Each objInlineShape In objTempDocument.InlineShapes objInlineShape.Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter objInlineShape.ScaleHeight = 50 objInlineShape.ScaleWidth = 50 Next End If End Sub Function IsEmbedded(objCurAttachment As Outlook.Attachment) As Boolean Dim objPropertyAccessor As Outlook.PropertyAccessor Dim strProperty As String Set objPropertyAccessor = objCurAttachment.PropertyAccessor strProperty = objPropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") If InStr(1, strProperty, "@") > 0 Then IsEmbedded = True Else IsEmbedded = False End If End Function
- After that, you can continue adding this macro to Quick Access Toolbar.
- Later, you should open the source email and then click the macro button in Quick Access Toolbar.
- At once, after macro finishes, you’ll get a Word document, like the following screenshot:
Fix Outlook Errors
It’s indeed common for regular users to encounter errors in Outlook. Usually, the first alternative is to utilize the built-in repair tool – Scanpst to resolve them. Yet, if the errors are so serious that they have been beyond what the inbox repair tool can do, you have to resort to a more powerful fix utility, like DataNumen Outlook Repair. It is able to fix Outlook issues effectively.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql recovery and outlook repair software products. For more information visit www.datanumen.com