Outlook: Tüm URL'ler tek bir e-postadan nasıl çıkarılır

Bir e-posta, bir metin dosyasına çıkarılması gereken yüzlerce URL içeriyorsa, bunları tek tek kopyalayıp yapıştırmak sıkıcı bir iş olacaktır. Bu eğitici, bir e-postadan tüm URL'leri hızla çıkarabilen VBA'ları tanıtır.

URL'leri bir e-postadan bir metin dosyasına çıkarmak için VBA

URL'leri birden çok e-postadan bir Excel dosyasına çıkarmak için VBA

URL'leri bir e-postadan bir metin dosyasına çıkarmak için VBA

1. URL'leri çıkarmak istediğiniz bir e-posta seçin ve Ara Toplam + F11 etkinleştirmek için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.

2. tık Ekle > modül yeni bir boş modül oluşturmak için aşağıdaki kodu kopyalayıp modüle yapıştırın.

VBA: Tüm URL'leri bir e-postadan bir metin dosyasına çıkarın.

Sub ExportUrlToTextFileFromEmail()
'UpdatebyExtendoffice20220413
  Dim xMail As Outlook.MailItem
  Dim xRegExp As RegExp
  Dim xMatchCollection As MatchCollection
  Dim xMatch As Match
  Dim xUrl As String, xSubject As String, xFileName As String
  Dim xFs As FileSystemObject
  Dim xTextFile As Object
  Dim i As Integer
  Dim InvalidArr
  On Error Resume Next
  If Application.ActiveWindow.Class = olInspector Then
    Set xMail = ActiveInspector.CurrentItem
  ElseIf Application.ActiveWindow.Class = olExplorer Then
    Set xMail = ActiveExplorer.Selection.Item(1)
  End If
  Set xRegExp = New RegExp
  With xRegExp
    .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
    .Global = True
    .IgnoreCase = True
  End With
  If xRegExp.test(xMail.Body) Then
    InvalidArr = Array("/", "\", "*", ":", Chr(34), "?", "<", ">", "|")
    xSubject = xMail.Subject
    For i = 0 To UBound(InvalidArr)
      xSubject = VBA.Replace(xSubject, InvalidArr(i), "")
    Next i
    xFileName = "C:\Users\Public\Downloads\" & xSubject & ".txt"
    Set xFs = CreateObject("Scripting.FileSystemObject")
    Set xTextFile = xFs.CreateTextFile(xFileName, True)
    xTextFile.WriteLine ("Export URLs:" & vbCrLf)
    Set xMatchCollection = xRegExp.Execute(xMail.Body)
    i = 0
    For Each xMatch In xMatchCollection
      xUrl = xMatch.SubMatches(0)
      i = i + 1
      xTextFile.WriteLine (i & ". " & xUrl & vbCrLf)
    Next
    xTextFile.Close
    Set xTextFile = Nothing
    Set xMatchCollection = Nothing
    Set xFs = Nothing
    Set xFolderItem = CreateObject("Shell.Application").NameSpace(0).ParseName(xFileName)
    xFolderItem.InvokeVerbEx ("open")
    Set xFolderItem = Nothing
  End If
  Set xRegExp = Nothing
End Sub

Bu kodda, e-posta konusuyla adlandırılan ve yola yerleştirilen yeni bir metin dosyası oluşturacaktır: C:\Kullanıcılar\Genel\İndirilenler, ihtiyacınıza göre değiştirebilirsiniz.

3. tık Araçlar > Referanslar etkinleştirmek Referanslar – Proje 1 iletişim kutusunu işaretleyin Microsoft VBScript Normal İfadeler 5.5 onay kutusu. Tıklayın OK.

4. Basın F5 anahtar veya tıklama koşmak düğmesini tıkladığınızda, şimdi bir metin dosyası çıkar ve içindeki tüm URL'ler ayıklanır.

not: Outlook 2010 ve Outlook 365 kullanıcılarıysanız, lütfen 3. Adımdaki Windows Komut Dosyası Ana Bilgisayar Nesne Modeli onay kutusunu da işaretleyin. Ardından, Tamam'ı tıklayın.

URL'leri birden çok e-postadan bir Excel dosyasına çıkarmak için VBA

Birden çok seçili e-postadan bir Excel dosyasına URL'leri çıkarmak istiyorsanız, aşağıdaki VBA kodu size yardımcı olabilir.

1. URL'leri çıkarmak istediğiniz bir e-posta seçin ve Ara Toplam + F11 etkinleştirmek için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.

2. tık Ekle > modül yeni bir boş modül oluşturmak için aşağıdaki kodu kopyalayıp modüle yapıştırın.

VBA: birden çok e-postadaki tüm URL'leri bir Excel dosyasına çıkarın

'UpdatebyExtendoffice20220414
Dim xExcel As Excel.Application
Dim xExcelWb As Excel.Workbook
Dim xExcelWs As Excel.Worksheet

Sub ExportAllUrlsToExcelFromMultipleEmails()
  Dim xMail As MailItem
  Dim xSelection As Selection
  Dim xWordDoc As Word.Document
  Dim xHyperlink As Word.Hyperlink
  On Error Resume Next
  Set xSelection = Outlook.Application.ActiveExplorer.Selection
  If (xSelection Is Nothing) Then Exit Sub
  Set xExcel = CreateObject("Excel.Application")
  Set xExcelWb = xExcel.Workbooks.Add
  Set xExcelWs = xExcelWb.Sheets(1)
  xExcelWb.Activate
  With xExcelWs
    .Range("A1") = "Subject"
    .Range("B1") = "DisplayText"
    .Range("C1") = "Link"
  End With
  With xExcelWs.Range("A1", "C1").Font
    .Bold = True
    .Size = 12
  End With
  For Each xMail In xSelection
    Set xWordDoc = xMail.GetInspector.WordEditor
    If xWordDoc.Hyperlinks.Count > 0 Then
      For Each xHyperlink In xWordDoc.Hyperlinks
          Call ExportToExcelFile(xMail, xHyperlink)
      Next
    End If
  Next
  xExcelWs.Columns("A:C").AutoFit
  xExcel.Visible = True
End Sub

Sub ExportToExcelFile(curMail As MailItem, curHyperlink As Word.Hyperlink)
  Dim xRow As Integer
  xRow = xExcelWs.Range("A" & xExcelWs.Rows.Count).End(xlUp).Row + 1
  With xExcelWs
    .Cells(xRow, 1) = curMail.Subject
    .Cells(xRow, 2) = curHyperlink.TextToDisplay
    .Cells(xRow, 3) = curHyperlink.Address
  End With
End Sub

Bu kodda, tüm köprüleri ve ilgili ekran metinlerini ve e-posta konularını çıkarır.

3. tık Araçlar > Referanslar etkinleştirmek Referanslar – Proje 1 diyalog, tik Microsoft Excel 16.0 Nesne Kitaplığı ve Microsoft Word 16.0 Nesne Kitaplığı onay kutuları. Tıklamak OK.

4. Ardından imleci VBA kodunun içine yerleştirin, F5 anahtar veya tıklama koşmak düğmesini tıklayın, şimdi bir çalışma kitabı çıkıyor ve içindeki tüm URL'ler ayıklandı, ardından onu bir klasöre kaydedebilirsiniz.

not: yukarıdaki VBA'ların tümü, tüm köprü türlerini çıkarır.

Outlook için Kutools - Outlook'a 100 Gelişmiş Özellik Getirir ve Çalışmayı Çok Daha Kolay Hale Getirir!

• Otomatik CC / BCC e-posta gönderirken kurallara göre; Otomatik İleri Özel olarak birden çok E-posta; Otomatik cevap değişim sunucusu olmadan ve daha fazla otomatik özellik ...
• BCC Uyarısı - tümünü yanıtlamaya çalıştığınızda mesaj göster posta adresiniz BCC listesindeyse; Eksik Olduğunda Hatırlatve daha fazlası özellikleri hatırlat ...
• Posta görüşmesindeki Tüm Eklerle Yanıtla (Tümü); Birçok E-postayı Yanıtla saniyeler içinde; Otomatik Karşılama Ekleme cevap verdiğinde; Konuya Tarih Ekle ...
• Ek Araçları: Tüm Postalardaki Tüm Ekleri Yönetin, Otomatik Ayır, Tümünü Sıkıştır, Tümünü Yeniden Adlandır, Tümünü Kaydet ... Hızlı Rapor, Seçili Postaları Say...
• Güçlü Önemsiz E-postalar özel olarak; Yinelenen Postaları ve Kişileri Kaldır... Outlook'ta daha akıllı, daha hızlı ve daha iyi yapmanızı sağlar.

Devamı ... Şimdi İndirin...