[發問] 選擇資料夾 進而取得其名字

yangjie

請教各位先進們
        在表單裡  想用視窗作選擇  得到 某一個資料匣名字(含路徑) 應如下語法?
類似如下視窗作選擇  得到 某一個檔
    Filt = "Excel Files (*.xls),*.xls"
    FilterIndex = 5
    Title = "選擇資料匯入之來源Excel檔"
    FileName = Application.GetOpenFilename _
        (FileFilter:=Filt, _
         FilterIndex:=FilterIndex, _
         Title:=Title)
    If UCase(FileName) = "FALSE" Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    xlfileName = Dir(FileName)
而我需要的是  選擇資料夾     進而取得其資料夾名字。
求救於先進們            謝謝

yangjie

回復 1# yangjie
自行參考說明 自編成如下:
Sub getfolder()
    Dim f1 As Object
    Set f1 = CreateObject("Scripting.FileSystemObject")
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
        .FilterIndex = 2
        If .Show = -1 Then
            For Each FileName In .SelectedItems
                 FolderName = f1.GetParentFolderName(Path:=FileName)
            Next FileName
        End If
    End With
    Set f1 = Nothing
    Set fd = Nothing
End Sub
但不會設定成只能選一個?  請教教我！

GBKEE

回復 2# yangjie

1. Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
2.     With fd
   
3.      .AllowMultiSelect = True '
   
4.      'AllowMultiSelect 屬性 True 如果允許使用者從檔案對話方塊選取多個檔案。讀/寫 Boolean
   
5.     '但AllowMultiSelect 屬性對 msoFileDialogFolderPicker 不起作用

複製代碼

可用表單

1. Option Explicit
   
2. Private Sub UserForm_Initialize()
   
3.     Ex
   
4.     With ListBox1  '請先在表單中加入這控制項
   
5.         .Font.Size = 12
   
6.         .Top = 10
   
7.         .Height = .ListCount * .Font.Size
   
8.          DoEvents
   
9.         .Left = 10
   
10.         .Width = 300
    
11.         .MultiSelect = fmMultiSelectMulti  '接受多重選取
    
12.         Width = .Width + 20
    
13.         Height = .Height + 40
    
14.     End With
    
15. End Sub
    
16. Private Sub ListBox1_Change()
    
17.     Dim s As String, i As Integer
    
18.     With ListBox1
    
19.         For i = 0 To .ListCount - 1
    
20.             If .Selected(i) = True Then s = s & .List(i) & vbLf
    
21.         Next
    
22.         If s <> "" Then MsgBox s
    
23.     End With
    
24. End Sub
    
25. Private Sub Ex()
    
26.     Dim f As Object, e
    
27.     Set f = CreateObject("Scripting.FileSystemObject").getfolder(CurDir).SubFolders
    
28.     For Each e In f
    
29.         ListBox1.AddItem e
    
30.     Next
    
31. End Sub

複製代碼

yangjie

回復 3# GBKEE
謝了