Как бързо да експортирате всички прикачени изображения на имейл в Outlook в работен лист на Excel

Ако искате бързо да експортирате всички прикачени изображения на имейл на Outlook в работен лист на Excel, можете да се обърнете към тази статия. Тук ще ви покажем по-ефективен начин от ръчното експортиране.

Когато получите имейл, който съдържа ahost на прикачените изображения, ако искате да ги използвате за създаване на отчет в Excel, трябва да копнеете за начин, който може да експортира тези изображения в работен лист на Excel на партиди. Сега ще ви представим такъв подход по-долу.

Експортирайте всички прикачени изображения на имейл към работен лист на Excel

1. Като начало отворете вашето приложение Outlook по нормален начин.
2. След това в прозореца на Outlook натиснете клавишните комбинации „Alt + F11“, което ще изведе прозореца „Microsoft Visual Basic за приложения“.
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. Може да предложи most ефективно средство за защита в случай на Корупция в Outlook.

Въведение на автора:

Шърли Джанг е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително sql възстановяване и outlook софтуерни продукти за ремонт. За повече информация посетете WWW.datanumen.com