Outlook: Cách trích xuất tất cả các URL từ một email
Nếu một email chứa hàng trăm URL cần được trích xuất thành một tệp văn bản, thì việc sao chép và dán từng URL một sẽ là một công việc tẻ nhạt. Hướng dẫn này giới thiệu các VBA có thể nhanh chóng trích xuất tất cả các URL từ email.
VBA để trích xuất URL từ một email sang tệp văn bản
VBA để trích xuất URL từ nhiều email vào một tệp Excel
- Gửi email tự động với Auto CC / BCC, Tự động chuyển tiếp theo quy định; gửi Tự động trả lời (Vắng mặt) mà không cần máy chủ trao đổi...
- Nhận lời nhắc như Cảnh báo BCC khi trả lời tất cả khi bạn đang ở trong danh sách BCC và Nhắc nhở khi thiếu tệp đính kèm để quên các tệp đính kèm...
- Cải thiện hiệu quả email với Trả lời (Tất cả) kèm tệp đính kèm, Tự động thêm lời chào hoặc ngày và giờ vào chữ ký hoặc chủ đề, Trả lời nhiều emailhữu ích. Cảm ơn !
- Hợp lý hóa việc gửi email với Thu hồi email, Công cụ đính kèm (Nén tất cả, Tự động lưu tất cả...), Loại bỏ các bản saovà Báo cáo nhanhhữu ích. Cảm ơn !
VBA để trích xuất URL từ một email sang tệp văn bản
1. Chọn một email mà bạn muốn trích xuất các URL và nhấn Khác + F11 phím để kích hoạt Microsoft Visual Basic cho các ứng dụng cửa sổ.
2. nhấp chuột Chèn > Mô-đun để tạo một mô-đun trống mới, sau đó sao chép và dán mã bên dưới vào mô-đun.
VBA: trích xuất tất cả các URL từ một email thành một tệp văn bả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
Trong mã này, nó sẽ tạo một tệp văn bản mới được đặt tên với chủ đề email và được đặt trong đường dẫn: C: \ Users \ Public \ Downloads, bạn có thể thay đổi nó khi bạn cần.
3. nhấp chuột CÔNG CỤ > dự án để cho phép Tài liệu tham khảo - Đồ án 1 hộp thoại, đánh dấu vào Microsoft VBScript Biểu thức chính quy 5.5 hộp kiểm. Nhấp chuột OK.
4. nhấn F5 phím hoặc bấm chạy để chạy mã, bây giờ một tệp văn bản bật ra và tất cả các URL đã được trích xuất trong đó.
Chú thích: nếu bạn là người dùng Outlook 2010 và Outlook 365, vui lòng đánh dấu vào hộp kiểm Windows Script Host Object Model ở Bước 3. Sau đó bấm OK.
VBA để trích xuất URL từ nhiều email vào một tệp Excel
Nếu bạn muốn trích xuất URL từ nhiều email đã chọn sang tệp Excel, mã VBA dưới đây có thể giúp bạn.
1. Chọn một email mà bạn muốn trích xuất các URL và nhấn Khác + F11 phím để kích hoạt Microsoft Visual Basic cho các ứng dụng cửa sổ.
2. nhấp chuột Chèn > Mô-đun để tạo một mô-đun trống mới, sau đó sao chép và dán mã bên dưới vào mô-đun.
VBA: trích xuất tất cả các URL từ nhiều email vào một tệp 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
Trong mã này, nó trích xuất tất cả các siêu liên kết và các văn bản hiển thị tương ứng và các chủ đề email.
3. nhấp chuột CÔNG CỤ > dự án để cho phép Tài liệu tham khảo - Đồ án 1 hộp thoại, đánh dấu Thư viện đối tượng Microsoft Excel 16.0 và Thư viện đối tượng Microsoft Word 16.0 hộp kiểm. Nhấp chuột OK.
4. Sau đó đặt con trỏ trong mã VBA, nhấn F5 phím hoặc bấm chạy để chạy mã, bây giờ một sổ làm việc bật ra và tất cả các URL đã được trích xuất trong đó, sau đó bạn có thể lưu nó vào một thư mục.
Chú thích: tất cả các VBA trên đều trích xuất tất cả các loại siêu liên kết.
Công cụ năng suất văn phòng tốt nhất
Kutools cho Outlook - Hơn 100 tính năng mạnh mẽ để tăng cường Outlook của bạn
📧 Tự động hoá email: Vắng Mặt (Có sẵn cho POP và IMAP) / Lên lịch gửi email / Tự động CC/BCC theo quy định khi gửi Email / Tự động chuyển tiếp (Quy tắc nâng cao) / Tự động thêm lời chào / Tự động chia email nhiều người nhận thành các tin nhắn riêng lẻ hữu ích. Cảm ơn !
📨 Quản lý email: Dễ dàng thu hồi email / Chặn email lừa đảo theo chủ đề và những người khác / Xóa các email trùng lặp / Tìm Kiếm Nâng Cao / Hợp nhất các thư mục hữu ích. Cảm ơn !
📁 Tệp đính kèm chuyên nghiệp: Lưu hàng loạt / Tách hàng loạt / Nén hàng loạt / Tự động lưu / Tự động tách / Tự động nén hữu ích. Cảm ơn !
🌟 Giao diện ma thuật: 😊Thêm nhiều biểu tượng cảm xúc đẹp và thú vị hơn / Tăng năng suất Outlook của bạn với chế độ xem theo thẻ / Thu nhỏ Outlook thay vì đóng hữu ích. Cảm ơn !
👍 Kỳ quan chỉ bằng một cú nhấp chuột: Trả lời tất cả bằng tệp đính kèm đến / Email chống lừa đảo / 🕘Hiển thị múi giờ của người gửi hữu ích. Cảm ơn !
👩🏼🤝👩🏻 Danh bạ & Lịch: Thêm hàng loạt liên hệ từ các email đã chọn / Chia nhóm liên hệ thành các nhóm riêng lẻ / Xóa lời nhắc sinh nhật hữu ích. Cảm ơn !
Trên 100 tính năng Chờ đợi sự khám phá của bạn! Bấm vào đây để khám phá thêm.