Kako brzo izvesti sve slikovne priloge Outlook e-pošte u Excel radni list

Podijeli sada:

Ako želite brzo izvesti sve privitke slika Outlook e-pošte u Excel radni list, možete pogledati ovaj članak. Ovdje ćemo vam pokazati efikasniji način od ručnog izvoza.

Kada primite e-poruku koja sadrži mnoštvo slikovnih priloga, ako ih želite koristiti za izradu izvještaja u Excelu, morate pronaći način kojim možete izvesti te slike u Excel radni list u serijama. U nastavku ćemo vam predstaviti takav pristup.

Brzo izvezite sve slikovne priloge Outlook e-pošte u Excel radni list

Izvezite sve slikovne priloge e-pošte u Excel radni list

  1. Za početak, pristupite svojoj Outlook aplikaciji na normalan način.
  2. Zatim, u prozoru programa Outlook, pritisnite prečice tipke “Alt + F11”, što će otvoriti prozor “Microsoft Visual Basic za aplikacije”.
  3. Na ovom ekranu morate otvoriti modul koji se ne koristi ili direktno umetnuti novi.
  4. Zatim, trebali biste kopirati dio VBA koda ispod u ovaj 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

VBA kod - Izvezite sve slikovne priloge e-pošte u Excel radni list

  1. Nakon toga, možete izaći iz makroa.
  2. Zatim idite na “File” > “Options” > “Quick Access Toolbar” da dodate ovaj makro na traku s alatima za brzi pristup.
  3. Konačno, ovaj makro možete isprobati upravo sada.
  • Prvo odaberite ili otvorite izvornu e-poštu.
  • Zatim kliknite na dugme makro na traci sa alatkama za brzi pristup.
  • Kada se makronaredba završi, dobićete Excel radni list, prikazan kao na sljedećem snimku ekrana:Izvezen Excel radni list

Zaštitite Outlook datoteku od oštećenja

Poznato je da je Outlook sklon korupciji. Stoga bismo trebali razumjeti kako zaštititi Outlook od korupcije. Kao prvo, da biste blokirali napade virusa, potrebno je instalirati antivirusni softver i nikada ne preuzimati nepoznati prilog. Osim toga, bolje nam je da nabavimo moćan alat za popravku, kao što je DataNumen Outlook RepairMože ponuditi najefikasniji lijek u slučaju Outlook korupcija.

Uvod za autora:

Shirley Zhang je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući sql oporavak i Outlook softverski proizvodi za popravku. Za više informacija posjetite www.datanumen.com

Podijeli sada:

Komentari su zatvoreni.