上边图的我会做〜只是下边图多个红框部份〜不知道要怎么镶嵌上去？

BrowseForFolder(Me.hwnd, "選擇相片保存位置", , NEWFOLDER)
不知道是不是這個,你試下.

这个是用 API 调用生成的。

你百度一下吧，有这方面的介绍。

我的代码是这样写的～不知道要怎加上那个功能？（但是这样写并没有那个功能）
百度查找的关键字示什么？提示一下～

Form1

Private Sub BrowseCmd_Click()

Dim Path As String

    Path = BrowseForFolder(Me, 0, "Select Project's Location :")
    If (Trim(Path) <> "") Then
        TextTarget.Text = Path
    End If
    
    ComAdd1.Enabled = True: ComAdd2.Enabled = True
    ComLess1.Enabled = True: ComLess2.Enabled = True
    
End Sub

Module1

Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Public 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

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const MAX_PATH_LEN = (256 - 1)


Public Function BrowseForFolder(ByRef owner As Form, ByRef StartLoc As Long, ByRef Title As String) As String

Dim lpbi As BrowseInfo
Dim lpIDList As Long
Dim sPath As String
Dim iNull As Integer
Dim code As Integer, Description As String

On Error GoTo ErrorHandling
    
    With lpbi
        'Set the owner window
        .hWndOwner = owner.hwnd
        ' Specific Root Location
        .pIDLRoot = StartLoc
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat(Title, "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(lpbi)
    If lpIDList Then
        sPath = String$(MAX_PATH_LEN, 0)
        'Get the path from the IDList
        Call SHGetPathFromIDList(lpIDList, sPath)
        'free the block of memory
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
           sPath = Left$(sPath, iNull - 1)
        End If
    End If
    BrowseForFolder = sPath
    
Exit Function

ErrorHandling:

    code = Err.Number
    Description = Err.Description
    MsgBox "BrowseForFolder" & " " & code & " " & Description
    Resume Next
    
End Function

[ 本帖最后由 wube 于 2011-5-20 14:20 编辑 ]

Path = BrowseForFolder(Me, 0, "Select Project's Location :")
加一個參數就行了
Path = BrowseForFolder(Me, 0, "Select Project's Location :",,NEWFOLDER)

Option Explicit
   
  Private Type BROWSEINFOTYPE
          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 LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
  Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
  Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long
  Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
  Private Const WM_USER = &H400
  Private Const BFFM_SETSELECTIONA       As Long = (WM_USER + 102)
  Private Const BFFM_SETSELECTIONW       As Long = (WM_USER + 103)
  Private Const LPTR = (&H0 Or &H40)
   
  Public Enum BROWSETYPE
          NONE = 0
          PATHTEXT = 16
          NEWFOLDER = 64
  End Enum
   
  Private Sub BrowseCallbackProcStr(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long)
          If uMsg = 1 Then
                  Call SendMessage(hwnd, BFFM_SETSELECTIONA, True, ByVal lpData)
          End If
  End Sub
   
  Private Function FunctionPointer(FunctionAddress As Long) As Long
          FunctionPointer = FunctionAddress
  End Function
   
  Public Function BrowseForFolder(ByVal hwnd As Long, ByVal strTitle As String, Optional selectedPath As String, Optional ByVal Flag As BROWSETYPE = 0) As String
          Dim Browse_for_folder     As BROWSEINFOTYPE
          Dim itemID     As Long
          Dim selectedPathPointer     As Long
          Dim tmpPath     As String * 256
            
          If selectedPath = "" Then selectedPath = ""                 '避免selectedPath未初始化而出錯
            
          If Not Right(selectedPath, 1) <> "\" Then
                  selectedPath = Left(selectedPath, Len(selectedPath) - 1)             '如果用戶加了   "\"   則刪除
          End If
            
          With Browse_for_folder
                  .hOwner = hwnd       '所有都視窗之控制碼
                  .lpszTitle = strTitle       '對話方塊的標題
                  .ulFlags = Flag
                  .lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr)         '用於設置預設檔夾的回調函數
                  selectedPathPointer = LocalAlloc(LPTR, Len(selectedPath) + 1)             '分配一個字串記憶體
                  Call CopyMemory(ByVal selectedPathPointer, ByVal selectedPath, Len(selectedPath) + 1)                   '   拷貝那個路徑到記憶體
                  .lParam = selectedPathPointer       '   預設的文件夾
          End With
          itemID = SHBrowseForFolder(Browse_for_folder)       '執行API函數：BrowseForFolder
          If itemID Then
                  If SHGetPathFromIDList(itemID, tmpPath) Then         '取得選定的檔夾
                          BrowseForFolder = Left(tmpPath, InStr(tmpPath, vbNullChar) - 1)               '去掉多餘的   null   字元
                  End If
                  Call CoTaskMemFree(itemID)     '釋放記憶體
          End If
          Call LocalFree(selectedPathPointer)     '釋放記憶體
  End Function

谢谢了～用出来了～原来加一个参数就行了～
要写Me.hwnd～不能直接写Me～不然BrowseForFolder Type会出问题～

试过的结果要这样写才行～
path = BrowseForFolder(Me.hwnd, "Select Project's Location :", , NEWFOLDER)

总之解决了～感谢高手～