Outlook：XNUMXつの電子メールからすべてのURLを抽出する方法

電子メールにテキストファイルに抽出する必要がある URL が何百も含まれている場合、それらを XNUMX つずつコピーして貼り付けるのは面倒な作業になります。このチュートリアルでは、電子メールからすべての URL をすばやく抽出できる VBA を紹介します。

XNUMX つの電子メールから URL をテキストファイルに抽出する VBA

複数の電子メールから URL を Excel ファイルに抽出する VBA

Office タブ - Microsoft Office でタブによる編集と参照を有効にし、仕事をスムーズにします

続きを読みます...ダウンロード...

Kutools for Outlook - 100 以上の高度な機能で Outlook を強化し、優れた効率を実現します

メール送信を自動化する自動CC / BCC, 自動転送規則によって。送信自動返信 (不在時) Exchange サーバーを必要とせず...
などのリマインダーを受け取る BCC警告 BCC リストに登録しているときに全員に返信する場合、添付ファイルがない場合に通知する忘れた添付ファイルについては...
メールの効率を向上させる添付ファイル付きで返信 (すべて), 署名または件名に挨拶または日付と時刻を自動追加, 複数のメールに返信する...
メール送信を効率化するメールの取り消し, アタッチメントツール (すべて圧縮、すべて自動保存...)、重複を削除する, クイックレポート...

これらの高度な機能を使用して、Outlook 2021 ～ 2010 または Outlook 365 を強化します。包括的な 60 日間の無料トライアルを利用して、メールエクスペリエンスを向上させてください。

続きを読みます...ダウンロード...

XNUMX つの電子メールから URL をテキストファイルに抽出する VBA

1. URLを抽出したいメールを選択し、を押します。他の + F11 有効にするキー アプリケーション向け Microsoft Visual Basic 窓。

2。クリック インセット > モジュール 新しい空のモジュールを作成するには、以下のコードをコピーしてモジュールに貼り付けます。

VBA: XNUMX つの電子メールからすべての 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:\ユーザー\パブリック\ダウンロード、必要に応じて変更できます。

ドキュメント抽出 URL 1

3。クリック ツール > 参考文献 有効にする 参考資料 – プロジェクト 1 ダイアログで、チェックマークを付けます MicrosoftVBScript正規表現5.5 チェックボックス。クリック OK.

ドキュメント抽出 URL 1

4。押す F5 キーまたはクリックランボタンをクリックしてコードを実行すると、テキストファイルがポップアップ表示され、その中にすべての URL が抽出されます。

ドキュメント抽出 URL 1

Note: Outlook 2010 および Outlook 365 のユーザーの場合は、手順 3 で [Windows Script Host Object Model] チェックボックスもオンにしてください。次に、[OK] をクリックします。

複数の電子メールから URL を Excel ファイルに抽出する VBA

選択した複数の電子メールから URL を Excel ファイルに抽出する場合は、以下の VBA コードが役に立ちます。

1. URLを抽出したいメールを選択し、を押します。他の + F11 有効にするキー アプリケーション向け Microsoft Visual Basic 窓。

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

このコードでは、すべてのハイパーリンク、対応する表示テキスト、および電子メールの件名を抽出します。

ドキュメント抽出 URL 1

3。クリック ツール > 参考文献 有効にする 参考資料 – プロジェクト 1 ダイアログ、チェックマーク Microsoft Excel16.0オブジェクトライブラリ & Microsoft Word16.0オブジェクトライブラリ チェックボックス。クリック OK.

ドキュメント抽出 URL 1