【覚書】［Shell32.Shell］.Namespaceメソッドの引数でハマった話

VBA一般 VBA自作メソッド VBA覚書

【覚書】Shell32.Shell.Namespaceメソッドの引数でハマった話

結論だけ手っ取り早く知りたい方はコチラ。

何があったのか

事の発端：Shell32.Shellオブジェクトを使うマクロ

かつて、

akashi-keirin.hatenablog.com

こんなネタを書いていた。

レイト・バインディング風味に書き換え

この頃はアーリー・バインディング派だったので、当然のようにバリバリ（死語）に参照設定をして、Newしまくってイキっていた。

しかし、時は巡り、また夏が来て……を繰り返しているうち、すっかり考え方も変わり、今ではバリバリ（死語）のレイト・バインディング派になったのである！

そこで、参照設定を外して、レイト・バインディング風にコードを書き換えたのである。

リスト１　書き換え前
'宣言セクション'
'Microsoft Scripting Runtime参照設定'
'Microsoft Shell Controls And Automation参照設定'
Private m_FSO As New Scripting.FileSystemObject
Private m_Shell As New Shell32.Shell

Public Function SetLastModifiedDateTime( _
            ByVal a_Path As String, _
            ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Scripting.File
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Shell32.Folder
  Set tgtFolder = m_Shell.Namespace(tgtDir)
  'ファイルを取得'
  Dim tgtItem As Shell32.FolderItem
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  setLastModifiedDateTime = True
  Exit Function
HandleError:
  Call Err.Clear
End Function

ブログを書いた頃に比べると、少しコーディング・スタイルが変わっているぞ。

リスト２　書き換え後
'宣言セクション'
Private m_FSO As Object
Private m_Shell As Object

Public Function SetLastModifiedDateTime( _
                ByVal a_Path As String, _
                ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  If m_FSO Is Nothing Then
    Set m_FSO = CreateObject("Scripting.FileSystemObject")
  End If
  If m_Shell Is Nothing Then
    Set m_Shell = CreateObject("Shell.Application")
  End If
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Object
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Object
  Set tgtFolder = m_Shell.Namespace(tgtDir)
  'ファイルを取得'
  Dim tgtItem As Object
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  SetLastModifiedDateTime = True: Exit Function
HandleError:
  Call Err.Clear
End Function

悲劇：なぜかエラーが出る

これで万全！　……のはずである。

しかし、標題の通り、なぜかエラーに見舞われるのである。

この通り、

Set tgtFolder = m_Shell.Namespace(tgtDir)

で、[Shell32.Shell].NamespaceメソッドがNothingを返すために、次の

Set tgtItem = tgtFolder.ParseName(tgtFile.Name)

がエラーになってしまうのである！

これは全然意味がわからんぞ！

救いの神現る

……てなことを、Twitterでぼやいていたら、来ましたよ。

まさか、引数の型が原因だったとは。

さらに書き換え

そこで、コードを書き換える……といっても、書き換えるのは1行だけですが！

リスト３　さらに書き換え後
'宣言セクション'
Private m_FSO As Object
Private m_Shell As Object

Public Function SetLastModifiedDateTime( _
                ByVal a_Path As String, _
                ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  If m_FSO Is Nothing Then
    Set m_FSO = CreateObject("Scripting.FileSystemObject")
  End If
  If m_Shell Is Nothing Then
    Set m_Shell = CreateObject("Shell.Application")
  End If
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Object
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Object
  Set tgtFolder = m_Shell.Namespace(CVar(tgtDir)) '……(*)'
  'ファイルを取得'
  Dim tgtItem As Object
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  SetLastModifiedDateTime = True: Exit Function
HandleError:
  Call Err.Clear
End Function

変えたのは、(*)のところだけ。

要するに、フォルダパスの文字列をVariant型にキャストして[Shell32.Shell].Namespaceメソッドに渡しただけ。

これでエラーが出なくなった。

おわりに

レイト・バインディング方式で、[Shell32.Shell].Namespaceメソッドを使うときには、引数をVariant型で渡しましょう！

ちなみに、コチラのページでも、

Shell.NameSpace( _
  ByVal vDir As Variant _
) As Folder

と書いてある（「vDir」）ので、引数はVariant型、ということなのでしょう。

久々に小ハマリした報告でした。