Outlook: كيفية استخراج جميع عناوين URL من بريد إلكتروني واحد

إذا احتوى بريدك الإلكتروني على مئات روابط URL التي تحتاج إلى استخراجها إلى ملف نصي، فإن نسخها ولصقها يدويًّا واحدة تلو الأخرى سيكون مهمة شاقة ومملة. يقدم لك هذا البرنامج التعليمي أكواد VBA القوية التي تستخرج جميع روابط URL من البريد الإلكتروني بسرعة فائقة!

كود VBA لاستخراج عناوين URL من بريد إلكتروني واحد إلى ملف نصي

كود VBA لاستخراج عناوين URL من عدة رسائل بريد إلكتروني إلى ملف Excel

كود VBA لاستخراج عناوين URL من بريد إلكتروني واحد إلى ملف نصي

1. حدد البريد الإلكتروني الذي تريد استخراج عناوين URL منه، ثم اضغط على مفاتيحAlt+F11 لفتح نافذةMicrosoft Visual Basic for Applications.

2. انقر فوقInsert > Module لإنشاء وحدة نمطية فارغة جديدة، ثم انسخ الكود أدناه والصقه في الوحدة النمطية.

كود VBA: استخرج جميع عناوين URL من بريد إلكتروني واحد واحفظها في ملف نصي.

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

في هذا الكود، سيتم إنشاء ملف نصي جديد باسم موضوع البريد الإلكتروني وحفظه في المسار: C:\Users\Public\Downloads، ويمكنك تعديله حسب حاجتك.

3. انقر فوقTools > References لفتح مربع حوارReferences – Project 1، ثم حدد خانة الاختيار الخاصة بـMicrosoft VBScript Regular Expressions 5.5. بعد ذلك، انقر فوقOK.

4. اضغط على مفتاحF5 أو انقر فوق زرRun لتشغيل الكود، وسيظهر الآن ملف نصي يحتوي على جميع عناوين URL المستخرجة.

ملاحظة: إذا كنت من مستخدمي Outlook 2010 وOutlook 365، فيُرجى تحديد خانة الاختيار الخاصة بـ Windows Script Host Object Model في الخطوة 3 أيضًا، ثم انقر فوق «موافق».

كود VBA لاستخراج عناوين URL من عدة رسائل بريد إلكتروني إلى ملف Excel

إذا كنت ترغب في استخراج عناوين URL من عدة رسائل بريد إلكتروني محددة وحفظها في ملف Excel، فإن كود VBA أدناه سيساعدك.

1. حدد البريد الإلكتروني الذي تريد استخراج عناوين URL منه، واضغط على مفاتيحAlt+F11لفتح نافذةMicrosoft Visual Basic for Applications.

2. انقر فوقInsert>Moduleلإنشاء وحدة نمطية فارغة جديدة، ثم انسخ والصق الكود أدناه في الوحدة النمطية.

كود VBA: استخراج جميع عناوين URL من عدة رسائل بريد إلكتروني إلى ملف Excel

'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

في هذا الكود، يتم استخراج جميع الروابط التشعبية مع عرض النص المرتبط بها وموضوع البريد الإلكتروني.

3. انقر فوقTools > References لفتح مربع حوارReferences – Project 1، ثم حدد خانتي الاختيار الخاصتين بـMicrosoft Excel 16.0 Object Library وMicrosoft Word 16.0 Object Library. بعد ذلك، انقر فوقOK.

4. بعد ذلك، ضع المؤشر داخل كود VBA، ثم اضغط على مفتاحF5 أو انقر فوق زرRun لتشغيل الكود. وسيظهر لك الآن مصنف يحتوي على جميع عناوين URL المستخرجة، ويمكنك حفظه بسهولة في المجلد الذي تريده.

ملاحظة: تقوم جميع أكواد VBA المذكورة أعلاه باستخراج جميع أنواع الروابط التشعبية.

---

أفضل أدوات إنتاجية Office

جرِّب Kutools لـ Outlook الجديد كليًّا مع 100+ ميزة رائعة!انقر للتنزيل الآن!

🤖KUTOOLS AI:يستخدم تقنية ذكاء اصطناعي متقدمة للتعامل مع رسائل البريد الإلكتروني بسلاسة، بما في ذلك الرد عليها، وتلخيصها، وتحسينها، وتوسيعها، وترجمتها، وصياغتها.

📧أتمتة البريد الإلكتروني: الرد التلقائي (متوفر لبروتوكولي POP وIMAP) / جدولة إرسال رسائل البريد الإلكتروني / نسخة تلقائية/مخفية وفق القواعد عند إرسال البريد الإلكتروني / التحويل التلقائي (قاعدة متقدمة) / إضافة التحيّة تلقائيًّا / تقسيم رسائل البريد الإلكتروني ذات المستلمين المتعددين تلقائيًّا إلى رسائل فردية...

📨إدارة البريد الإلكتروني: استدعاء البريد الإلكتروني / حظر رسائل الاحتيال حسب العناوين وغيرها / حذف الرسائل المكررة / البحث المتقدم / تنظيم المجلدات...

📁المرفقات الاحترافية: حفظ دفعة واحدة / فصل دفعة واحدة / ضغط دفعة واحدة / حفظ تلقائي / تفصيل تلقائي / ضغط تلقائي...

🌟سحر الواجهة: 😊إيموجيات أكثر جمالًا وروعة / إشعارك عند وصول رسائل بريد إلكتروني مهمة / تصغير Outlook بدلًا من إغلاقه...

👍عجائب النقرة الواحدة: الرد على الجميع مع المرفقات / الحماية من رسائل التصيد الاحتيالي / 🕘عرض منطقة الوقت الحالي للمرسل...

👩🏼‍🤝‍👩🏻جهات الاتصال والتقويم: إضافة جهات اتصال دفعةً واحدة من رسائل البريد الإلكتروني المحددة / تقسيم مجموعة جهات الاتصال إلى مجموعات فردية / إزالة تذكير عيد الميلاد...

استخدم Kutools باللغة التي تفضلها – يدعم الإنجليزية، الإسبانية، الألمانية، الفرنسية، الصينية، وأكثر من 40 لغة أخرى!

افتح Kutools لـ Outlook بنقرة واحدة فورًا! لا تنتظر، نزِّله الآن وحسِّن كفاءتك!

قائمة ميزات Kutools لـ Outlook      نزِّل الآن      اذهب للشراء

🚀 التنزيل بنقرة واحدة — احصل على جميع إضافات Office

موصى به بشدة: Kutools for Office (5 في 1)

نقرة واحدة لتنزيلخمسة برامج تثبيتدفعة واحدة —Kutools لـ Excel وOutlook وWord وPowerPointوOffice Tab Pro.انقر للتنزيل الآن!

• ✅سهولة النقرة الواحدة: نزِّل جميع حزم الإعداد الخمس دفعة واحدة!
• 🚀جاهز لأي مهمة في Office: ثبِّت الإضافات التي تحتاجها، متى احتجتَ إليها.
• 🧰متضمَّن: Kutools لـ Excel / Kutools لـ Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

حول الحزمة⬇ نزِّل الحزمة💳 اشترِ الحزمة