Az Outlook e-mail összes képmellékletének gyors exportálása Excel-munkalapba

Ha gyorsan szeretné exportálni egy Outlook e-mail összes képmellékletét egy Excel-munkalapba, tekintse meg ezt a cikket. Itt bemutatunk egy hatékonyabb módszert, mint a kézi exportálás.

Amikor egy e-mailt kap, amely számos képmellékletet tartalmaz, és azokat Excel-jelentés készítéséhez szeretné felhasználni, szüksége lesz egy olyan módszerre, amellyel ezeket a képeket kötegekben exportálhatja egy Excel-munkafüzetbe. Most bemutatunk egy ilyen megközelítést.

Egy e-mail összes képmellékletének exportálása Excel-munkalapba

1. Kezdésként a szokásos módon nyissa meg az Outlook alkalmazást.
2. Ezután az Outlook ablakban nyomja meg az „Alt + F11” billentyűkombinációt, amely megjeleníti a „Microsoft Visual Basic for Applications” ablakot.
3. Ezen a képernyőn meg kell nyitnia egy nem használt modult, vagy azonnal be kell helyeznie egy újat.
4. Ezután be kell másolnia az alábbi VBA-kódot ebbe a modulba.

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. Ezt követően kiléphet a makróból.
6. Ezután lépjen a „Fájl” > „Opciók” > „Gyorselérési eszköztár” elemre, hogy hozzáadja ezt a makrót a Gyorselérési eszköztárhoz.
7. Végül most kipróbálhatja ezt a makrót.

• Először válassza ki vagy nyisson meg egy forrás e-mailt.
• Ezután kattintson a makró gombra a Gyorselérési eszköztárban.
• Amikor a makró befejeződik, egy Excel-munkalapot fog kapni, amely az alábbi képernyőképen látható:

Védje az Outlook fájlt a sérüléstől

Köztudott, hogy az Outlook hajlamos a korrupcióra. Ezért meg kell értenünk, hogyan védhetjük meg az Outlookot a korrupció ellen. Először is, a vírustámadások megakadályozása érdekében víruskereső szoftvert kell telepíteni, és soha ne töltsön le ismeretlen mellékleteket. Emellett jobban járunk, ha beszerzünk egy erős javítószerszámot, mint pl DataNumen Outlook RepairA leghatékonyabb gyógymódot kínálhatja a következő esetekben: Az Outlook korrupciója.

Szerző Bevezetés:

Shirley Zhang adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve sql helyreállítás és outlook javítószoftver termékek. További információért látogasson el www.datanumen.com