Jak rychle exportovat všechny přílohy obrázků e-mailu aplikace Outlook do listu aplikace Excel

Pokud chcete rychle exportovat všechny obrázkové přílohy e-mailů aplikace Outlook do listu aplikace Excel, můžete si přečíst tento článek. Zde vám ukážeme efektivnější způsob než ruční export.

Pokud obdržíte e-mail s velkým množstvím obrázkových příloh a chcete je použít k vytvoření zprávy v Excelu, musíte hledat způsob, jak tyto obrázky dávkově exportovat do excelového listu. Nyní vám takový přístup představíme v následujícím textu.

Exportujte všechny obrázkové přílohy e-mailu do listu aplikace Excel

1. Nejprve běžným způsobem přistupujte k aplikaci Outlook.
2. Poté v okně Outlooku stiskněte klávesovou zkratku „Alt + F11“, čímž se zobrazí okno „Microsoft Visual Basic for Applications“.
3. Na této obrazovce musíte otevřít modul, který se nepoužívá, nebo přímo vložit nový.
4. Dále byste měli zkopírovat část kódu VBA níže do tohoto modulu.

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. Poté můžete makro ukončit.
6. Poté přejděte na „Soubor“> „Možnosti“> „Panel nástrojů Rychlý přístup“ a přidejte toto makro na Panel nástrojů Rychlý přístup.
7. Nakonec můžete toto makro vyzkoušet právě teď.

• Nejprve vyberte nebo otevřete zdrojový e-mail.
• Poté klikněte na tlačítko makra na panelu nástrojů Rychlý přístup.
• Po dokončení makra se zobrazí list aplikace Excel, který se zobrazuje jako následující snímek obrazovky:

Chraňte soubor aplikace Outlook před poškozením

Je známo, že Outlook je náchylný k poškození. Proto bychom měli rozumět tomu, jak chránit Outlook před poškozením formulářů. Chcete-li blokovat virové útoky, je nejprve nutné nainstalovat antivirový software a nikdy nestahovat neznámou přílohu. Kromě toho je lepší sehnat silný nástroj pro opravu, jako je DataNumen Outlook RepairMůže nabídnout nejúčinnější nápravu v případě Outlook korupce.

Úvod autora:

Shirley Zhang je expertem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně zotavení sql a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com