この記事では、フォルダを参照してフォルダを選択するためのダイアログボックスを表示するための手順を作成しました。

このコードは、実行時にフォルダーの選択が必要な他のマクロと一緒に使用できます。

SelectingFolder

ロジックの説明

この記事では、フォルダーを参照するためのダイアログボックスを表示するために2つのAPI関数を参照しました。

フォルダブラウザを使用して特定のフォルダを選択すると、ダイアログボックスは選択したフォルダのパスを返します。

コードについては以下に従ってください

Option Explicit

'Declaring user data type

'Used by the function GetFolderName

Private Type BROWSEINFO

hOwner As Long

pidlRoot As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfn As Long

lParam As Long

iImage As Long

End Type

'Declaring reference to API Function

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _

Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _

Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String

'Returns the name of the folder selected by the user

Dim bInfo As BROWSEINFO, path As String, r As Long

Dim X As Long, pos As Integer



bInfo.pidlRoot = 0

'Type of directory to return

bInfo.ulFlags = &H1

'Display the dialog

X = SHBrowseForFolder(bInfo)

'Parse the result

path = Space$(512)

'Calling API function

r = SHGetPathFromIDList(ByVal X, ByVal path)

'Code for deleting extra spaces in the end of folder name return

If r Then

pos = InStr(path, Chr(0))

GetFolderName = Left(path, pos - 1)

Else

GetFolderName = ""

End If

End Function

Sub TestGetFolderName()

Dim FolderName As String

'Calling function GetFolderName

FolderName = GetFolderName("Select a folder")

If FolderName = "" Then

MsgBox "You didn't select a folder."

Else

MsgBox "You selected this folder: " & FolderName

End If

End Sub

このブログが気に入ったら、FacebookやFacebookで友達と共有してください。

皆様からのご意見をお待ちしております。私たちの仕事を改善し、あなたのために改善する方法をお知らせください。 [email protected]までご連絡ください