Slik eksporterer du raskt alle bildevedlegg av en Outlook-e-post til et Excel-regneark

Hvis du raskt vil eksportere alle bildevedlegg av en Outlook-e-post til et Excel-regneark, kan du se denne artikkelen. Her vil vi vise deg en mer effektiv måte enn manuell eksport.

Når du mottar en e-post som inneholder en rekke bildevedlegg, og du vil bruke dem til å lage en rapport i Excel, må du lete etter en måte å eksportere disse bildene til et Excel-regneark i grupper. Nå skal vi introdusere deg for en slik tilnærming i det følgende.

Eksporter alle bildevedlegg av en e-post til et Excel-regneark

1. Til å begynne med får du tilgang til Outlook-applikasjonen din på vanlig måte.
2. Deretter, i Outlook-vinduet, trykker du på "Alt + F11" snarveier, som vil få opp vinduet "Microsoft Visual Basic for Applications".
3. I denne skjermen må du åpne en modul som ikke er i bruk eller sette inn en ny rett.
4. Deretter bør du kopiere VBA-koden nedenfor til denne modulen.

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. Etter det kan du avslutte makroen.
6. Gå deretter til "Fil"> "Alternativer"> "Hurtigtilgangsverktøylinje" for å legge til denne makroen til verktøylinjen for hurtigtilgang.
7. Endelig kan du prøve denne makroen akkurat nå.

• Først velger eller åpner du en kilde-e-post.
• Klikk deretter på makroknappen i verktøylinjen for hurtigtilgang.
• Når makroen er fullført, vil du få et Excel-regneark, vist som følgende skjermbilde:

Beskytt Outlook-filen mot å bli korrupt

Det er kjent at Outlook er utsatt for korrupsjon. Derfor bør vi forstå hvordan vi beskytter Outlook-formkorrupsjon. Først og fremst, for å blokkere virusangrep, er det nødvendig å installere antivirusprogramvare og aldri laste ned ukjent vedlegg. Dessuten er vi bedre å få tak i et potent reparasjonsverktøy, som f.eks DataNumen Outlook RepairDet kan tilby det mest effektive middelet i tilfelle Outlook-korrupsjon.

Forfatterintroduksjon:

Shirley Zhang er en datagjenopprettingsekspert innen DataNumen, Inc., som er verdensledende innen datagjenopprettingsteknologier, inkludert sql utvinning og Outlook-reparasjonsprodukter. For mer informasjon besøk www.datanumen. Med