Outlook: 1つのメールからすべてのURLを抽出する方法
あるメールに数百のURLが含まれており、それらをテキストファイルに抽出する必要がある場合、1つずつコピーして貼り付けるのは非常に面倒な作業です。このチュートリアルでは、メールからすべてのURLを迅速に抽出できるVBAを紹介します。
1つのメールからテキストファイルにURLを抽出するためのVBA
複数のメールからExcelファイルにURLを抽出するためのVBA
- AI技術を使用してメールの生産性を向上させ、迅速な返信、新規作成、メッセージの翻訳などをより効率的に行えます。
- 自動CC/BCCやルールによる自動転送でメールを自動化し、Exchangeサーバーなしで自動返信(外出中)を送信...
- BCCに自分が含まれている場合に全員に返信する際のBCC警告や、添付ファイルを忘れた場合の「添付ファイルがない場合のリマインダー」などの通知を受け取れます...
- 添付ファイル付きでの返信(全員)、挨拶または日時を署名または件名に自動追加、複数のメールへの返信などにより、メールの効率を向上させます...
- メール取り消し、添付ファイルツール(すべて圧縮、自動保存)、重複したメールの削除、クイックレポートなどでメール業務を合理化します...
1つのメールからテキストファイルにURLを抽出するためのVBA
1. URLを抽出したいメールを選択し、Alt + F11キーを押してMicrosoft Visual Basic for Applicationsウィンドウを開きます。
2. 「挿入」>「モジュール」をクリックして新しい空白モジュールを作成し、以下のコードをコピーしてモジュールに貼り付けます。
VBA:1つのメールからすべての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. 「ツール」>「参照設定」をクリックして 「参照設定 - プロジェクト1」ダイアログを開き、「Microsoft VBScript Regular Expressions 5.5」のチェックボックスをオンにします。「OK」をクリックします。


4. F5 キーを押すか「実行」 ボタンをクリックしてコードを実行すると、テキストファイルが表示され、すべてのURLがそこに抽出されます。


注意: Outlook 2010およびOutlook 365のユーザーは、ステップ3で「Windows Script Host Object Model」のチェックボックスもオンにしてください。その後、「OK」をクリックします。
複数のメールからExcelファイルにURLを抽出するためのVBA
複数の選択したメールからURLをExcelファイルに抽出したい場合、以下のVBAコードが役立ちます。
1. URLを抽出したいメールを選択し、Alt + F11 キーを押して Microsoft Visual Basic for Applicationsウィンドウを開きます。
2. 「挿入」>「モジュール」をクリックして新しい空白モジュールを作成し、以下のコードをコピーしてモジュールに貼り付けます。
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. 「ツール」>「参照設定」をクリックして「参照設定 - プロジェクト1」ダイアログを開き、「Microsoft Excel 16.0 Object Library」と「 Microsoft Word 16.0 Object Library」のチェックボックスをオンにします。「OK」をクリックします。


4. カーソルをVBAコード内に置き、F5キーを押すか「実行」ボタンをクリックしてコードを実行します。これでワークブックが表示され、すべてのURLが抽出されます。その後、それをフォルダーに保存できます。

注意: 上記のすべてのVBAは、すべての種類のハイパーリンクを抽出します。
最高のオフィス生産性ツール
速報: Kutools for Outlook が無料版をリリース!
新しい Kutools for Outlook の無料版を体験してください。70以上の素晴らしい機能が永遠に使えます!今すぐダウンロードをクリック!
🤖 Kutools AI : 高度なAI技術を使用して、メールの返信、要約、最適化、拡張、翻訳、作成を簡単に行います。
📧 メール自動化: 自動返信 (POPとIMAPで利用可能) / メール送信のスケジュール / メール送信時にルールによる自動 CC/BCC / 自動転送 (高度なルール) / 自動挨拶追加 / 複数の宛先を持つメールを個別のメールに自動的に分割...
📨 メール管理: メールの取り消し / 件名やその他によるスパムメールのブロック / 重複したメールの削除 / 高度な検索 / フォルダーを整理...
📁 添付ファイルプロ: バッチ保存 / バッチ切り離し / バッチ圧縮 / 自動保存 / 自動的に切り離す / 自動圧縮...
🌟 インターフェースマジック: 😊より美しくクールな絵文字 /重要なメールが来たときに通知 / クローズ中ではなくOutlookを最小化...
👍 ワンクリックの驚き: 全員に【Attachment】付きで返信 / フィッシング対策メール / 🕘送信者のタイムゾーンを表示...
👩🏼🤝👩🏻 連絡先とカレンダー: 選択したメールから連絡先を一括追加 /連絡先グループを個別のグループに分割 / 誕生日のリマインダーを削除...
Kutools for Outlook をワンクリックで即座にアンロック。待たずに今すぐダウンロードして効率を高めましょう!

