Hiện hộp thoại Browse for folder

[chibi]

Trong VBA muốn mở hoặc lấy tên file tôi thường dùng Application.GetOpenFilename, nay muốn hỏi các bạn cách lấy tên thư mục? Xin các bạn giúp đỡ.

 

[levanduyet]

Bạn vào đây.
http://www.cpearson.com/excel/FolderTree.aspx


LVD

 

[chessbase10]

Trong VBA muốn mở hoặc lấy tên file tôi thường dùng Application.GetOpenFilename, nay muốn hỏi các bạn cách lấy tên thư mục? Xin các bạn giúp đỡ.

Thử cái này xem, nếu ta muốn trả kết quả tìm kiếm ra ô A1:

Sub BrowseFolder()
 Dim objShell As Object, objFolder As Object, foundfolder As String
 On Error Resume Next
 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder(&H0&, "Choose one folder", &H1&)

 foundfolder = objFolder.ParentFolder.ParseName(objFolder.Title).Path
 Range("a1") = foundfolder
 End Sub

From ChiBi:
Cảm ơn chessbase10.
Bạn có thể giải thích rõ hơn về tham số &H0& và &H1& được không.
Đoạn code trên không trả về tên ổ đĩa khi ta chọn, chỉ trả về được tên thư mục. Khắc phục bằng cách nào để trả về được cả tên ổ đĩa?

 

[chessbase10]

Cảm ơn chessbase10.
Bạn có thể giải thích rõ hơn về tham số &H0& và &H1& được không.
Đoạn code trên không trả về tên ổ đĩa khi ta chọn, chỉ trả về được tên thư mục. Khắc phục bằng cách nào để trả về được cả tên ổ đĩa?

Ủa, tôi thử chọn từng ổ dĩa một, nó hiện ra đầy đủ mà. Bạn thử lại đi.
H0 và H1 để quy định header cho cái hộp hiện ra ấy mà, thiếu 1 thành phần nào trong đó đều không hiện ra hộp chọn.

From ChiBi:
Gửi Chessbase10, khi tôi chọn ổ đĩa C: thì trong A1 không hiện "C:", bạn kiểm tra giúp tôi tệp gửi kèm nhé. Cảm ơn nhiều.

 

[levanduyet]

Chào chibi,
File của bạn là lấy đường dẫn thư mục.
Nếu bạn muốn lấy tên thư mục thì bạn phải viết thêm đoạn code để xử lý.
Ví dụ khi foundFolder trả về: C:\ThuMuc1\BaiTap, bạn phải viết đoạn code để lấy về BaiTap

Lê Văn Duyệt

 

[chessbase10]

Gửi Chessbase10, khi tôi chọn ổ đĩa C: thì trong A1 không hiện "C:", bạn kiểm tra giúp tôi tệp gửi kèm nhé. Cảm ơn nhiều.

Bạn phải chọn thư mục con chứ, còn thư mục gốc của ổ đĩa thì để tôi nghiên cứu sau vậy.

Gửi bạn chibi
Tôi vừa sưu tầm được cái này trên http://www.levanduyetexcel.netfirms.com/File_folders.htm dùng rất tuyệt

Private Type BROWSEINFO  ' Duoc su dung boi ham GetFolderName'
   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

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
   ' Tra ve ten cua thu muc ma nguoi dung chon'
   Dim bInfo As BROWSEINFO, path As String, r As Long, X As Long, pos As Integer
   bInfo.pidlRoot = 0&  ' Root folder = Desktop'
   If IsMissing(Msg) Then
      bInfo.lpszTitle = "Chon mot thu muc."  ' Title cua hop thoai'
   Else
      bInfo.lpszTitle = Msg  ' Title cua hop thoai'
   End If
   bInfo.ulFlags = &H1  ' Kieu cua thu muc tra ve (Type of directory to return)'
   X = SHBrowseForFolder(bInfo)  ' The hien hop thoai'
   ' Phan tich ket qua (Parse the result)'
   path = Space$(512)
   r = SHGetPathFromIDList(ByVal X, ByVal path)
   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
   FolderName = GetFolderName("Select a folder")
   If FolderName = "" Then
      MsgBox "Ban da khong chon thu muc nao ca."
   Else
      MsgBox "Ban da chon thu muc: " & FolderName
   End If
End Sub