【VBA】マイフォルダ(デスクトップ、ドキュメント、ダウンロード)のフルパスを取得する方法

Excel VBA 一覧

ご訪問ありがとうございます。

Googleシートマスターのひろしです。

前回

【VBA】Excel PDF出力する方法 (1行のスクリプトでOK！)

今回は、PDF出力してみましょう。といっても、とても簡単です。スクリプト的には1行で終わりです。

PDFファイルを出力したのですが、
その際に、パスを指定する場合は、フルパスで指定する必要があります。

なので今回は、「デスクトップ」、「ダウンロード」、「ドキュメント」の
フォルダをフルパスで取得する方法です。

デスクトップ

CreateObject("WScript.Shell").SpecialFolders("desktop")

で、「デスクトップ」が取得できます。

Sub GetMyFullPath()

Dim upath As String

'デスクトップ
upath = CreateObject("WScript.Shell").SpecialFolders("desktop")
Debug.Print upath

End Sub

同様に「ドキュメント」も取得できます。

'ドキュメント
upath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
Debug.Print upath

ただ、「ダウンロード」は、

CreateObject("WScript.Shell").SpecialFolders("Downloads")

としても取得できません。

なので、一旦「ドキュメント」のパスを取得し、パス内の「Documents」の部分を
「Downloads」(ダウンロード)に置換することで、「ドキュメント」の
パスに変更します。↓

    'ダウンロード
    upath = Replace(upath, "\Documents", "\Downloads", 1, 1)
    Debug.Print upath

例) デスクトップ、ドキュメント、ダウンロードパスの取得

Sub GetMyFullPath()

Dim upath As String

'デスクトップ
upath = CreateObject("WScript.Shell").SpecialFolders("desktop")
Debug.Print upath


'ドキュメント
upath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
Debug.Print upath


'ダウンロード
upath = Replace(upath, "\Documents", "\Downloads", 1, 1)
Debug.Print upath

End Sub

実行結果

ついでに、3つのパスのいずれかを取得する処理を作ってみました。

とりあえず、デスクトップのフルパスを取得し後は、置換しています。

デスクトップ、ドキュメント、ダウンロードフォルダのフルパス取得ルーチン

GetMyPath()を呼び出す際に、0(デスクトップ)、1(ドキュメント)、2(ダウンロード)を
指定すればOKです。

Const ID_DESKTOP = 0 'デスクトップ
Const ID_DOCUMENT = 1 'ドキュメント
Const ID_DOWNLOAD = 2 'ダウンロード

'テスト用の呼び元
Sub sampleGetPath()
'デスクトップのフルパスを取得
Debug.Print GetMyPath(ID_DESKTOP)

'ドキュメントフォルダのフルパスを取得
Debug.Print GetMyPath(ID_DOCUMENT)

'ダウンロードフォルダのフルパスを取得
Debug.Print GetMyPath(ID_DOWNLOAD)

End Sub

'-------------------------------------------------------
'フルパスを取得する
'id
'ID_DESKTOP デスクトップ
'ID_DOCUMENT ドキュメント
'ID_DOWNLOAD ダウンロード
'戻り値 指定されたIDのフルパス(c:\
'-------------------------------------------------------
Function GetMyPath(id)

Dim upath As String

'とりあえずデスクトップで作成する
upath = CreateObject("WScript.Shell").SpecialFolders("desktop")

'ドキュメントとダウンロードは置換する
Select Case id
Case ID_DOCUMENT
upath = Replace(upath, "\Desktop", "\Document", 1, 1)

Case ID_DOWNLOAD
upath = Replace(upath, "\Desktop", "\Downloads", 1, 1)
End Select

GetMyPath = upath

End Function