VBAでデスクトップなど特定のフォルダを指定するには

VBAでファイルの入出力をデスクトップのフォルダに対してする場合，ユーザー名を含んだパスをどう取るんだっけ…と「vba デスクトップパス」などで検索して上位に出てくる記事で確認しました。が，Windows XP時代の古い情報もあったので，ここで整理しておきたいと思います。

1 基本的なコード
2 1行で
3 いろいろなSpecialFolders
4 SpecialFoldersをチェック

基本的なコード

一番上に出てきたmougの記事を参考にすると以下のように。もちろんセオリーはこの通りですが，Windows Scripting Hostオブジェクトを変数にセットして，使用後，最後に解放する，という手間を踏んでいます。

    Dim Path As String, WSH As Variant '変数宣言
    Set WSH = CreateObject("Wscript.Shell") 'WSHオブジェクト
    Path = WSH.SpecialFolders("Desktop") & "\" 'パスを変数に代入
    '処理（省略）
    Set WSH = Nothing’オブジェクト解放

Dim Path As String, WSH As Variant '変数宣言

Set WSH = CreateObject("Wscript.Shell") 'WSHオブジェクト

Path = WSH.SpecialFolders("Desktop") & "\" 'パスを変数に代入

'処理（省略）

Set WSH = Nothing’オブジェクト解放

1行で

2番目に出てきたブログの記事を参考すると，次のように。WSHを1回しか使わないのであれば，わざわざオブジェクトを用意しなくても，使い捨てでこのように1行で書いてしまえば良いと思います。

strFileName = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "¥"

1	strFileName = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "¥"

いろいろなSpecialFolders

上記のブログ記事には，デスクトップ以外のいろいろなSpecialFoldersの一覧が載っていましたが，Windows XP時代の情報でした。

Windows 7では以下のようになります。

SpecialFolders.Item( )の引き数には，上記の文字列のほか，0~17の番号でも良いようです。ちなみに4と10は”Desktop”で重複しているようです。

SpecialFoldersをチェック

これらを確認するため，以下のサンプルマクロで確認しました。イミディエイトウィンドウにそれぞれのパスが表示されます。

Option Explicit

Sub SpecialFoldersTest()

    Dim i As Variant
    
    For Each i In Array("AllUsersDesktop", "AllUsersStartMenu", "AllUsersPrograms", _
                         "AllUsersStartup", "Desktop", "AppData", "PrintHood", _
                         "Templates", "Fonts", "NetHood", "Desktop", "StartMenu", _
                         "SendTo", "Recent", "Startup", "Favorites", "MyDocuments", _
                         "Programs")
                         
        Debug.Print CreateObject("WScript.Shell").SpecialFolders.Item(i)
        
    Next i

End Sub

Sub SpecialFoldersTest2()

    Dim i As Integer
    
    For i = 0 To 17
    
        Debug.Print CreateObject("WScript.Shell").SpecialFolders.Item(i)
        
    Next i

End Sub

Option Explicit

Sub SpecialFoldersTest()

Dim i As Variant

For Each i In Array("AllUsersDesktop", "AllUsersStartMenu", "AllUsersPrograms", _

"AllUsersStartup", "Desktop", "AppData", "PrintHood", _

"Templates", "Fonts", "NetHood", "Desktop", "StartMenu", _

"SendTo", "Recent", "Startup", "Favorites", "MyDocuments", _

"Programs")

Debug.Print CreateObject("WScript.Shell").SpecialFolders.Item(i)

Next i

End Sub

Sub SpecialFoldersTest2()

Dim i As Integer

For i = 0 To 17