Просмотр папки для выбора папки с помощью VBA в Microsoft Excel
В этой статье мы создали процедуру, которая используется для отображения диалогового окна, которое используется для просмотра папки для выбора папки.
Этот код можно использовать вместе с другими макросами, когда во время выполнения требуется выбор папки.
Логическое объяснение
В этой статье мы сделали ссылку на две функции 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]