メッセージに含まれる URL をすべて開くマクロ


インターネットのサービスには、メールマガジンを受信し、そのリンクをクリックするとポイントがもらえるというものがあります。
そのようなメッセージの中には多数の URL が含まれていて、そのうちのどれか一つだけがポイントをもらえる URL だったりすることがあり、ポイントをもらうために何度もメールの URL をクリックしなければならなかったりします。
一方、最近のブラウザはタブブラウザとなっているため、多数の URL を同時に開いたほうが効率的という場合もあります。
そこで、現在開いているメッセージに含まれる URL をすべて開いてしまうマクロを作ってみました。
Internet Explorer で使用する場合は、Internet Explorer の [タブ ブラウズの設定] で [他のプログラムのリンクを開く方法] を [現在のウィンドウの新しいタブ] にしてください。

' ここをトリプルクリックでマクロ全体を選択できます。
Sub OpenAllUrl()
    Dim objMsg As MailItem
    Dim l As Long
    Dim e As Long
    Dim strUrl As String
    Dim strExt As String
    Dim objShell As Object
    '
    Set objMsg = ActiveInspector.CurrentItem
    Set objShell = CreateObject("WScript.Shell")
    l = InStr(objMsg.Body, "http")
    While l > 0
        e = InStr(l, objMsg.Body, vbLf)
        e2 = InStr(l, objMsg.Body, """")
        If e2 > 0 And e2 < e Then
            e = e2
        End If
        strUrl = Mid(objMsg.Body, l, e - l)
        strExt = LCase(Right(strUrl, 4))
        If strExt <> ".gif" And strExt <> ".jpg" Then
            Debug.Print strUrl, strExt
            objShell.Run strUrl
        End If
        DoEvents
        l = InStr(e, objMsg.Body, "http")
    Wend
End Sub

マクロの登録方法やメニューへの追加について

広告

メッセージに含まれる URL をすべて開くマクロ」への2件のフィードバック

  1. お世話になっております。おかげさまで仕事が効率化されました。
    e2 = InStr(l, objMsg.Body, “”””)
    ですが、もしURLの最後に”で区切られていたら外すための部分かと思うのですが、
    Outlook 2010では”が検索できないようでうまく動作しません。Chr(34)にしてみたりもしたのですが、、、
    Excelでは”は検索できているので文法的には問題ないですし、、、
    現状、そのようなURL表記のメールがないので特に困ってはいないのですが、何かアイデアがあればご教示いただければと思います。

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中