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

Office Sekmesi - Microsoft Office'te Sekmeli Düzenlemeyi ve Göz Atmayı Etkinleştirerek Çalışmayı Kolaylaştırın

Devamı ...Indirin ...

Kutools for Outlook - Üstün Verimlilik için Outlook'u 100'den Fazla Gelişmiş Özellikle Güçlendirin

E-posta göndermeyi otomatikleştirin Otomatik CC / BCC, Otomatik İleri kurallara göre; Göndermek Otomatik cevap (Ofis Dışında) değişim sunucusu gerektirmeden...
Şunun gibi hatırlatıcılar alın: BCC Uyarısı BCC listesindeyken herkese yanıt verirken ve Eksik Olduğunda Hatırlat Unutulan eklentiler için...
E-posta verimliliğini artırın Yanıtla (Tümü) Eklerle birlikte, İmzaya veya Konuya Otomatik Selamlama veya Tarih ve Saat Ekleme, Birden Fazla E-postayı Yanıtlayın...
E-posta göndermeyi kolaylaştırın E-postaları Geri Çağırma, Ek Araçları (Tümünü Sıkıştır, Tümünü Otomatik Kaydet...), Yinelemeleri Kaldır, ve Hızlı rapor...

Bu gelişmiş özelliklerle Outlook 2021 - 2010 veya Outlook 365'inizi güçlendirin. Kapsamlı 60 günlük ücretsiz deneme sürümünün keyfini çıkarın ve e-posta deneyiminizi geliştirin!

Devamı ...Indirin ...

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.

belge özü url 1

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

belge özü url 1

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.

belge özü url 1

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.

belge özü url 1

3. tık Tools > 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.

belge özü url 1

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.

belge özü url 1