如果目录是Desktoppath，则BrowseForFolder返回错误

下面的代码是用来允许用户浏览目录，如果位置是一个文件夹，它会工作得很好，如果输出目录是桌面path，它会失败。 当我debugging它显示“PickFolder = f.Items.Item.Path”上的错误。 错误消息是运行时错误“91”：对象variables或块variables未设置。 任何想法如何重写代码，以解决这个问题？ 谢谢

Public Function PickFolder() As String Dim SA As Object, f As Object Dim OutputPath As String 'Ensure user has enter business date value before process PickFolder function If BDTextBox.Text <> "" Then Set SA = CreateObject("Shell.Application") Set f = SA.BrowseForFolder(0, "Choose a folder", _ 16 + 32 + 64) If (Not f Is Nothing) Then PickFolder = f.Items.Item.Path OutputPath = PickFolder FinalFileName = ActiveWorkbook.FullName 'InStrRev will find the last occurrence of a character in a string. Search for \ and split it there FinalFileName = Mid(FinalFileName, InStrRev(FinalFileName, "\") + 1) 'Take off the extension FinalFileName = Left(FinalFileName, InStrRev(FinalFileName, ".") - 1) FinalFileName = FinalFileName WriteTextBox = OutputPath & "\" & FinalFileName & "_" & FinalBusinessDate 'MsgBox "value is " & FinalFileName & "_" & FinalBusinessDate End If Set f = Nothing Set SA = Nothing Else MsgBox "Unable to process. Please ensure Business Date was entered.", vbCritical End If End Function 

Answer 1

尝试在这里embedded你的逻辑：

 Function GetFolder() As String Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With NextCode: GetFolder = sItem Set fldr = Nothing End Function 

Answer 2

我的最爱（虽然不是我的）：

 Option Explicit Sub Sample() Dim Ret Dim InitFolder As String InitFolder = "C:\Users\Siddharth Rout\Desktop" Ret = BrowseForFolder(InitFolder) End Sub Function BrowseForFolder(Optional OpenAt As Variant) As Variant Dim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt) On Error Resume Next BrowseForFolder = ShellApp.self.Path On Error GoTo 0 Set ShellApp = Nothing Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Select Exit Function Invalid: BrowseForFolder = False End Function