Ordner auswählen Desktop

Function GetDirectory(apath As String) As String
Dim strOrdner As String
With Application.FileDialog(msoFileDialogFolderPicker)
If apath = "" Then
.InitialFileName = ThisWorkbook.Path & "\"
Else
.InitialFileName = apath
End If
.Title = "Ordnerauswahl " & pr_name
.ButtonName = "Auswählen..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1)  "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then
'Nichts tun
Else
GetDirectory = strOrdner
End If
End Function

Sub xyz()
verz01 = GetDirectory(CreateObject("WScript.Shell").specialfolders("Desktop"))
End Sub