Sådan eksporteres du hurtigt alle billedvedhæftninger i en Outlook-e-mail til et Excel-regneark

Hvis du hurtigt vil eksportere alle billedvedhæftninger i en Outlook-e-mail til et Excel-regneark, kan du henvise til denne artikel. Her viser vi dig en mere effektiv måde end manuel eksport.

Når du modtager en e-mail, der indeholder en række vedhæftede billeder, og du vil bruge dem til at lave en rapport i Excel, skal du lede efter en metode, der kan eksportere disse billeder til et Excel-regneark i batcher. Nu vil vi introducere dig til en sådan fremgangsmåde i det følgende.

Eksporter alle billedvedhæftninger i en e-mail til et Excel-regneark

1. Til at begynde med skal du åbne din Outlook-applikation på normal måde.
2. Derefter skal du i Outlook-vinduet trykke på "Alt + F11" -tastgenveje, som åbner vinduet "Microsoft Visual Basic for Applications".
3. På denne skærm skal du åbne et modul, der ikke bruges, eller indsætte et nyt lige.
4. Dernæst skal du kopiere nedenstående stykke VBA-kode til dette modul.

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. Derefter kan du afslutte makroen.
6. Gå derefter til "File"> "Options"> "Quick Access Toolbar" for at tilføje denne makro til Quick Access Toolbar.
7. Endelig kan du prøve denne makro lige nu.

• For det første skal du vælge eller åbne en kilde-e-mail.
• Klik derefter på makroknappen i værktøjslinjen Hurtig adgang.
• Når makroen er færdig, får du et Excel-regneark, vist som følgende skærmbillede:

Beskyt Outlook-fil mod at blive korrupt

Det vides, at Outlook er udsat for korruption. Derfor skal vi forstå, hvordan vi beskytter korruption i Outlook-form. Først og fremmest for at blokere virusangreb er det nødvendigt at installere antivirussoftware og aldrig downloade ukendt vedhæftet fil. Desuden er det bedre for os at få fat i et kraftigt reparationsværktøj, som f.eks DataNumen Outlook RepairDet kan tilbyde den mest effektive løsning i tilfælde af Outlook korruption.

Forfatter Introduktion:

Shirley Zhang er ekspert i datagendannelse i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder sql opsving og Outlook-reparationssoftwareprodukter. For mere information besøg www.datanumen.com