Bir Outlook E-postasının Tüm Resim Eklerini Hızlı Bir Şekilde Excel Çalışma Sayfasına Aktarma

Bir Outlook e-postasının tüm resim eklerini hızlı bir şekilde bir Excel çalışma sayfasına aktarmak istiyorsanız, bu makaleye başvurabilirsiniz. Burada size manuel olarak dışa aktarmaktan daha etkili bir yol göstereceğiz.

Çok sayıda resim eki içeren bir e-posta aldığınızda ve bunları Excel'de bir rapor oluşturmak için kullanmak istediğinizde, bu resimleri toplu olarak Excel çalışma sayfasına aktarabilecek bir yönteme ihtiyaç duyarsınız. Şimdi, aşağıda size böyle bir yaklaşımı tanıtacağız.

Bir E-postanın Tüm Resim Eklerini Excel Çalışma Sayfasına Aktarın

1. Başlangıç ​​olarak, Outlook uygulamanıza normal şekilde erişin.
2. Ardından, Outlook penceresinde, “Microsoft Visual Basic for Applications” penceresini getirecek olan “Alt + F11” kısayol tuşlarına basın.
3. Bu ekranda kullanılmayan bir modülü açmanız veya hemen yenisini takmanız gerekiyor.
4. Ardından, aşağıdaki VBA kod parçasını bu modüle kopyalamanız gerekir.

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. Bundan sonra makrodan çıkabilirsiniz.
6. Ardından, bu makroyu Hızlı Erişim Araç Çubuğuna eklemek için "Dosya" > "Seçenekler" > "Hızlı Erişim Araç Çubuğu"na gidin.
7. Son olarak, bu makroyu hemen şimdi deneyebilirsiniz.

• İlk olarak, bir kaynak e-posta seçin veya açın.
• Ardından, Hızlı Erişim Araç Çubuğundaki makro düğmesini tıklayın.
• Makro tamamlandığında, aşağıdaki ekran görüntüsü gibi gösterilen bir Excel çalışma sayfası alırsınız:

Outlook Dosyasını Bozulmaya Karşı Koruyun

Outlook'un yolsuzluğa eğilimli olduğu bilinmektedir. Bu nedenle, Outlook'un bozulmadan nasıl korunacağını anlamalıyız. Öncelikle, virüs saldırılarını engellemek için antivirüs yazılımı yüklemek ve bilinmeyen ekleri asla indirmemek gerekir. Ayrıca, güçlü bir onarım aracını ele geçirsek daha iyi olur, örneğin DataNumen Outlook RepairBu, şu durumlarda en etkili çözümü sunabilir: Outlook bozulması.

Yazar Tanıtımı:

Shirley Zhang, bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. sql kurtarma ve görünüm onarım yazılım ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com