えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

MENU
トップ > Outlook > Outlookでメール受信者がローカルパスをクリックできるようにUNCパス化するマクロを作ってみた

Outlookでメール受信者がローカルパスをクリックできるようにUNCパス化するマクロを作ってみた

Outlook VBA

Twitterにてアイディアを頂いて、昨日とは別の方法でOutlookのメール受信者がリンクをクリックできるようにするマクロを作ってみた。

概要

昨日はネットワークドライブのローカルパスを<"File://パス">とすることで、Outlookのメール受信者がハイパーリンクをクリック出来るようにしていた。

Before

Z:\share\01ほげほげ部\ぴよぴよ管理.xlsx

After

<"file://Z:\share\01ほげほげ部\ぴよぴよ管理.xlsx">

www.excel-chunchun.com


今回は逆転の発想で、ネットワークドライブに割り当てられているUNCパスを特定し、ドライブレターをUNCパスに置き換えることでOutlookのメール受信者がハイパーリンクをクリック出来るようにしてみた。

Before

X:\hoge.xls

After

<"\\server\share1\hoge.xls">

この方法のメリットは相手が同じドライブレターにマウントしていない場合でも、高い確率で機能するということだろう。


ドライブレターからUNCパスを特定する方法

ドライブレターからUNCパスを特定する方法を調べた結果、下記の3種類が見つかった。

  • MPR.dllのWNetGetConnectionAPIを使用
  • WSHのNetwork.EnumNetworkDrivesを使用
  • WMIのWbemScripting.SWbemLocatorを使用

これらは2種類に分ける事ができる。

  • WNetGetConnection
    • ドライブレターを渡すとUNCパスを取得する。
    • ネットワークドライブの割り当てで「登録済み」のドライブであれば何でも確認することが出来る。
  • WSHとWMI
    • 「接続済み」のネットワークドライブが全て列挙されたリストを取得する。
    • 「登録されているが接続していない」ドライブは取得できない。
    • （知らないだけでやり方はあるのかもしれない）


ネットワークドライブは、ユーザーがログインしてから初めてアクセスを試みたときに初めて接続済み状態になる（設定などによる）事があるので、最終的なプログラムではWNetGetConnectionを採用した。


WNetGetConnectionA

Private Declare Function WNetGetConnectionA Lib "mpr.dll" ( _
        ByVal lpszLocalName As String, _
        ByVal lpszRemoteName As String, _
        cbRemoteName As Long _
        ) As Long
Rem pub unsafe extern "system" fn WNetGetConnectionA(
Rem     lpLocalName: LPCSTR,
Rem     lpRemoteName: LPSTR,
Rem     lpnLength: LPDWORD
Rem ) -> DWORD

機能的にはシンプルな関数で、ドライブレターX:やZ:を渡すと`\サーバー名\共有名\を取得できる


これを使って関数化したものがこちら。

Rem ネットワークドライブのUNCパスを取得
Rem
Rem @param nDriveLetter     ドライブレター文字列（"A:"や"Z:"）
Rem
Rem @return As String       文字列
Rem
Rem @note サーバーにアクセスできるか否かは考慮しない。
Rem
Private Function GetUNCPathA(ByVal nDriveLetter As String) As String
    Dim Path As String * 1024
    If WNetGetConnectionA(nDriveLetter, Path, 1024) = 0 Then
        GetUNCPathA = Left(Path, InStr(Path, vbNullChar) - 1)
    End If
End Function


使用例

Sub Test_GetUNCPath()
    Debug.Print GetUNCPathA("X:")
End Sub


実行結果

\\server\Share1


WNetGetConnectionW

先のWNetGetConnectionAはUnicodeに対応できていないため、あれを使うのはバグの原因となる恐れがある。

だからUnicodeに対応しているWNetGetConnectionWの方を使いたかったのだが、どうにもこうにも上手く動かす方法が分からなかった。

Private Declare Function WNetGetConnectionW Lib "mpr.dll" ( _
        ByVal lpszLocalName As LongPtr, _
        ByVal lpszRemoteName As LongPtr, _
        cbRemoteName As Long _
        ) As Long
Rem pub unsafe extern "system" fn WNetGetConnectionW(
Rem     lpLocalName  : LPCWSTR,
Rem     lpRemoteName : LPWSTR,
Rem     lpnLength    : LPDWORD
Rem ) -> DWORD

使用例（失敗）

Private Function GetUNCPathW(ByVal nDriveLetter As String) As String
    Dim Path As String * 1024
    If WNetGetConnectionW(StrPtr(nDriveLetter), StrPtr(Path), 1024) = 0 Then
        GetUNCPathW = Left(Path, InStr(Path, vbNullChar) - 1)
    Else
        Debug.Print "ERR"
    End If
End Function

これを実行した時、ERRにはならないのだが、Pathの内容が常にvbNullCharで埋め尽くされた状態になってしまった。


追記

I氏より以下の情報を入手した。

固定長文字列のせいな感じがします。 可変長文字列で実行したところ無事取得できました。

というわけで、これを

Dim Path As String * 1024

下記のように変更。

Dim Path As String
Path = String(1024, vbNullChar)

ついでに1024が二回登場して気持ち悪いのでLenB(Path)へ変更。


使用例（成功）

Private Function GetUNCPathW(ByVal nDriveLetter As String) As String
    Dim Path As String
    Path = String(1024, vbNullChar)
    If WNetGetConnectionW(StrPtr(nDriveLetter), StrPtr(Path), LenB(Path)) = 0 Then
        GetUNCPathW = Left(Path, InStr(Path, vbNullChar) - 1)
    End If
End Function

これにて万事解決である。


WSHのNetwork.EnumNetworkDrivesを使用

WScript.NetworkオブジェクトのEnumNetworkDrivesによって、現在接続中のネットワークドライブだけを列挙することが出来る。

戻り値はIWshCollectionで、要素番号の

  • 偶数にドライブレターが
  • 奇数にUNCパスが

格納されている。

Sub Test_WSH()
    Dim NetworkDrives  ' As IWshCollection
    Set NetworkDrives = CreateObject("WScript.Network").EnumNetworkDrives
    Dim i As Long
    For i = 0 To NetworkDrives.Count - 1 Step 2
        If NetworkDrives.Item(i) <> "" Then
            Debug.Print NetworkDrives.Item(i), NetworkDrives.Item(i + 1)
        End If
    Next
End Sub


実行結果

X:      \\server\Share1
Y:      \\server\Share2


WMIのWbemScripting.SWbemLocatorを使用

WMIもWSHと同じで、現在接続中のネットワークドライブだけを列挙することが出来る。

下記のソースコードを使うときは、参照設定でMicrosoft WMI Scripting V1.2 Libraryを有効にしておくこと。

正直に申し上げるとI氏に教えて頂いたので、中身は全く理解していない。

（WMIはSQLを使って様々な情報が吸い出せるので、情シス目指すなら是非マスターしておきたいところだが・・・）

Sub Test_WMI()
    Const WQL = _
        "SELECT Name, ProviderName " & _
        "FROM Win32_LogicalDisk " & _
        "WHERE DriveType = 4"
    Dim drv As WbemScripting.SWbemObject
    For Each drv In CreateObject("WbemScripting.SWbemLocator").ConnectServer().ExecQuery(WQL)
        With drv.Properties_
            Debug.Print .Item("Name").Value, .Item("ProviderName").Value
        End With
    Next
End Sub


実行結果

X:      \\server\Share1
Y:      \\server\Share2


完成マクロ

仕様

上記を使って、前回のReplacePathToHyperlinkを改変して以下のような仕様にした。

  • ネットワークドライブのパスはUNCに変更することでハイパーリンク化
  • ローカルドライブのパスは <"file:// "> で囲うことでハイパーリンク化
  • UNCパスは <" "> で囲うことで途切れ防止
  • 既に変換済みのものは破壊しないように


使用例

f:id:Kotori-ChunChun:20191022214407p:plain


ソースコード

長文なのでGistに上げた。


参考資料

DOBON.NETプログラミング掲示板過去ログ - ネットワークドライブの絶対パスを取得するには？

dobon.net


チラシの裏 - ネットワークドライブ上のパスをUNCにする VBS

blog.livedoor.jp


Function mpr::WNetGetConnectionW

https://retep998.github.io/doc/mpr/fn.WNetGetConnectionW.htmlretep998.github.io


WNetGetConnectionWのVBAでの使用例

https://stackoverflow.com/questions/10402822/passing-a-lpctstr-parameter-to-an-api-call-from-vba-in-a-ptrsafe-and-unicode-saf



まとめ

繰り返しになるが、この方法のメリットは相手が同じドライブレターにマウントしていない場合でも、高い確率で機能するということだろう。

社内でドライブレターが統一されているのであれば、このような事をする必要はない。

下手に混在させると、いらぬ混乱を招いたりハイパーリンクが途切れてアレヤコレヤと困ったことになるかもしれない。

そこの所、注意して使うようにして欲しい。

以上

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)

プライバシーポリシー