كيف أتعامل مع صندوق الحوار هذا

عندك دالة اسمها BrowseForFolder في مكتبة shell32.dll

تستطيع استخدامها عن طريق تعريف الـ API

أو عن طريق إضافة الـ Reference لمكتبة Shell32 وهو Microsoft Shell Controls

وتعريف كائن من نوع Shell وأخر Folder

On Error Resume Next
Dim SH As New Shell
Dim Fol As Folder

 Set Fol = SH.BrowseForFolder(Me.hWnd, "Title", 1)
 MsgBox Fol.Items.Item.Path

أو تستخدم تعريف الـ API علي طول ..والمثال التالي من API Guide

Private Type BrowseInfo
	hWndOwner As Long
	pIDLRoot As Long
	pszDisplayName As Long
	lpszTitle As Long
	ulFlags As Long
	lpfnCallback As Long
	lParam As Long
	iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Sub Form_Load()
	'KPD-Team 1998
	'URL: http://www.allapi.net/
	'KPDTeam@Allapi.net
	Dim iNull As Integer, lpIDList As Long, lResult As Long
	Dim sPath As String, udtBI As BrowseInfo

	With udtBI
		'Set the owner window
		.hWndOwner = Me.hWnd
		'lstrcat appends the two strings and returns the memory address
		.lpszTitle = lstrcat("C:\", "")
		'Return only if the user selected a directory
		.ulFlags = BIF_RETURNONLYFSDIRS
	End With

	'Show the 'Browse for folder' dialog
	lpIDList = SHBrowseForFolder(udtBI)
	If lpIDList Then
		sPath = String$(MAX_PATH, 0)
		'Get the path from the IDList
		SHGetPathFromIDList lpIDList, sPath
		'free the block of memory
		CoTaskMemFree lpIDList
		iNull = InStr(sPath, vbNullChar)
		If iNull Then
			sPath = Left$(sPath, iNull - 1)
		End If
	End If

	MsgBox sPath
End Sub

المعامل الأخير للدالة وهو Root

يمكنك فيه تحديد المجلد الجذري الذي تريد البدء منه ..

كمثال :

Set Fol = SH.BrowseForFolder(Me.hWnd, "Title", 1, "C:\Windows")

انا تقريبا مفهمهتش حاجه

أزاى أنقل بيه الفولدر للمشروع بتاعى

Dim SH As New Shell
Dim Fol As Shell32.Folder
Dim objFSO As Object
Dim sPath As String
Set Fol = SH.BrowseForFolder(0&, "Title", 1, "C:\")
If Not Fol Is Nothing Then
   sPath = Fol.Items.Item.Path
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If Not (fso.FolderExists(App.Path & "\Back UP")) Then MkDir App.Path & "\Back UP"
	objFSO.CopyFolder sPath, App.Path & "\Back Up", 1
	MsgBox "Coping Done"
End If

ومرفق مثال

Copy_Folder_to_App_Path.rar

الف الف الف الف مليون شكر على المساعده جزاك الله خير أخى العزيز