Suchordner für die Auswahl Ordner mit VBA in Microsoft Excel
In diesem Artikel haben wir eine Prozedur erstellt, die zum Anzeigen des Dialogfelds verwendet wird, das zum Durchsuchen des Ordners zur Auswahl des Ordners verwendet wird.
Dieser Code kann zusammen mit anderen Makros verwendet werden, bei denen zur Laufzeit eine Ordnerauswahl erforderlich ist.
Logische Erklärung
In diesem Artikel haben wir auf zwei API-Funktionen verwiesen, um das Dialogfeld zum Durchsuchen von Ordnern anzuzeigen.
Wenn wir einen bestimmten Ordner mit dem Ordnerbrowser auswählen, gibt das Dialogfeld den Pfad des ausgewählten Ordners zurück.
Bitte folgen Sie unten für den Code
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
Wenn Ihnen dieser Blog gefallen hat, teilen Sie ihn mit Ihren Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]