Gruppe
Datei
Problem
Es soll ein Ordnerdialog mit dem in Zelle B1 genannten Ordner als Startverzeichnis aufgerufen und das Anlegen eines neuen Ordners ermöglcht werden.
StandardModule: Modul1
Sub OrdnerDialog()
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Dim Wscript As Application
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object
Dim objFile As Object
Dim colFiles As Object
Dim objWMIService As Object
Dim strComputer As String, strPath As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Wählen Sie einen Ordner aus:", NO_OPTIONS, Range("B1").Value)
If objFolder Is Nothing Then Exit Sub
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
strPath = Replace(strPath, "\", "\\")
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("Select * from Win32_Directory where name = '" & strPath & "'")
On Error GoTo ERRORHANDLER
For Each objFile In colFiles
Wscript.Echo "Readable: " & objFile.Readable
Next
ERRORHANDLER:
End Sub