Як швидко експортувати всі вкладення зображень електронної пошти Outlook на аркуш Excel

Якщо ви хочете швидко експортувати всі вкладення зображень електронної пошти Outlook на аркуш Excel, ви можете звернутися до цієї статті. Тут ми покажемо вам більш ефективний спосіб, ніж експорт вручну.

Коли ви отримуєте електронний лист із великою кількістю вкладених зображень, і хочете використовувати їх для створення звіту в Excel, вам потрібно знайти спосіб експортувати ці зображення в робочий аркуш Excel пакетами. Нижче ми розглянемо такий підхід.

Експортуйте всі вкладення зображень електронної пошти в аркуш Excel

1. Для початку відкрийте програму Outlook звичайним способом.
2. Потім у вікні Outlook натисніть сполучення клавіш “Alt + F11”, що відкриє вікно “Microsoft Visual Basic for Applications”.
3. На цьому екрані вам потрібно відкрити модуль, який не використовується, або прямо вставити новий.
4. Далі вам слід скопіювати фрагмент коду VBA нижче в цей модуль.

Sub ExportAllImageAttachmentsToExcelWorksheet()
    Dim objSourceMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim strImage As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim objFile As Object
    Dim objFiles As Object
    Dim nRow As Integer
 
    Select Case Outlook.Application.ActiveWindow.Class
           Case olInspector
                Set objSourceMail = ActiveInspector.currentItem
           Case olExplorer
                Set objSourceMail = ActiveExplorer.Selection.Item(1)
    End Select
 
    If Not (objSourceMail Is Nothing) Then
 
       'Save the image attachments to a temporary folder
       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
 
       'Create a new Excel workbook
        Set objExcelApp = CreateObject("Excel.Application")
        Set objExcelWorkbook = objExcelApp.Workbooks.Add
        Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
        objExcelApp.Visible = True
        objExcelWorkbook.Activate
 
        'Get the images in the temporary folder
        Set objFiles = objFileSystem.GetFolder(strTempFolder).Files
 
        'Insert the images into this new Excel worksheet
        For Each objFile In objFiles
            strImage = strTempFolder & Trim(objFile.Name)
            nRow = nRow + 1
            With objExcelWorksheet
                 .Range("A" & nRow).value = objFile.Name
                 'Change the height and width as per your needs
                 .Range("B" & nRow).ColumnWidth = 10
                 .Range("B" & nRow).RowHeight = 80
                 .Range("B" & nRow).Activate
                 With .Pictures.insert(strImage)
                      With .ShapeRange
                           .LockAspectRatio = msoTrue
                           .Width = 50
                           .Height = 70
                      End With
                 End With
                 .Columns("A").AutoFit
                 .Activate
            End With
       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

5. Після цього ви можете вийти з макросу.
6. Потім перейдіть до «Файл»> «Параметри»> «Панель швидкого доступу», щоб додати цей макрос на панель швидкого доступу.
7. Нарешті, ви можете спробувати цей макрос прямо зараз.

• По-перше, виберіть або відкрийте електронну пошту-джерело.
• Потім натисніть кнопку макросу на панелі швидкого доступу.
• Коли макрос завершиться, ви отримаєте робочий аркуш Excel, показаний як наведений нижче знімок екрана:

Захистіть файл Outlook від пошкодження

Відомо, що Outlook схильний до корупції. Тому ми повинні розуміти, як захистити Outlook від корупції. По-перше, щоб блокувати вірусні атаки, необхідно встановити антивірусне програмне забезпечення і ніколи не завантажувати невідоме вкладення. Крім того, нам краще взяти в руки потужний інструмент для ремонту, такий як DataNumen Outlook RepairВін може запропонувати найефективніший засіб у разі Корупція в Outlook.

Вступ автора:

Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі відновлення SQL та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com