Dim shl
Dim fd
Set shl = CreateObject("Shell.application")
Set fd = shl.BrowseForFolder(0, "请选择上报数据的保存路径或者软盘!", 0, 0)
If Not fd Is Nothing Then
   Strfile1 = fd.Self.Path
Else
   Exit Sub
End If
在WIN2000,WINXP下好用,在98下说不支持对像。
哪位老大给看看,怎样在98下用。

解决方案 »

  1.   

    使用API函数SHBrowseForFolder:http://www.applevb.com/sourcecode/2054_EBrowseF.zip
      

  2.   

    先把下面的代码放入BAS模块: 
        Option Explicit 
         
        'common to both methods 
        Public Type BROWSEINFO 
         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 
         
        Public Declare Function SHBrowseForFolder Lib _ 
         "shell32.dll" Alias "SHBrowseForFolderA" _ 
         (lpBrowseInfo As BROWSEINFO) As Long 
         
        Public Declare Function SHGetPathFromIDList Lib _ 
         "shell32.dll" Alias "SHGetPathFromIDListA" _ 
         (ByVal pidl As Long, _ 
         ByVal pszPath As String) As Long 
         
        Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) 
         
        Public Declare Function SendMessage Lib "user32" _ 
         Alias "SendMessageA" _ 
         (ByVal hWnd As Long, _ 
         ByVal wMsg As Long, _ 
         ByVal wParam As Long, _ 
         lParam As Any) As Long 
         
        Public Declare Sub MoveMemory Lib "kernel32" _ 
         Alias "RtlMoveMemory" _ 
         (pDest As Any, _ 
         pSource As Any, _ 
         ByVal dwLength As Long) 
         
        Public Const MAX_PATH = 260 
        Public Const WM_USER = &H400 
        Public Const BFFM_INITIALIZED = 1 
         
        'Constants ending in 'A' are for Win95 ANSI 
        'calls; those ending in 'W' are the wide Unicode 
        'calls for NT. 
         
        'Sets the status text to the null-terminated 
        'string specified by the lParam parameter. 
        'wParam is ignored and should be set to 0. 
        Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100) 
        Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104) 
         
        'If the lParam parameter is non-zero, enables the 
        'OK button, or disables it if lParam is zero. 
        '(docs erroneously said wParam!) 
        'wParam is ignored and should be set to 0. 
        Public Const BFFM_ENABLEOK As Long = (WM_USER + 101) 
         
        'Selects the specified folder. If the wParam 
        'parameter is FALSE, the lParam parameter is the 
        'PIDL of the folder to select , or it is the path 
        'of the folder if wParam is the C value TRUE (or 1). 
        'Note that after this message is sent, the browse 
        'dialog receives a subsequent BFFM_SELECTIONCHANGED 
        'message. 
        Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102) 
        Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103) 
         
         
        'specific to the PIDL method 
        'Undocumented call for the example. IShellFolder's 
        'ParseDisplayName member function should be used instead. 
        Public Declare Function SHSimpleIDListFromPath Lib _ 
         "shell32" Alias "#162" _ 
         (ByVal szPath As String) As Long 
         
         
        'specific to the STRING method 
        Public Declare Function LocalAlloc Lib "kernel32" _ 
         (ByVal uFlags As Long, _ 
         ByVal uBytes As Long) As Long 
         
        Public Declare Function LocalFree Lib "kernel32" _ 
         (ByVal hMem As Long) As Long 
         
        Public Declare Function lstrcpyA Lib "kernel32" _ 
         (lpString1 As Any, lpString2 As Any) As Long 
         
        Public Declare Function lstrlenA Lib "kernel32" _ 
         (lpString As Any) As Long 
         
        Public Const LMEM_FIXED = &H0 
        Public Const LMEM_ZEROINIT = &H40 
        Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT) 
         
         
        Public Function BrowseCallbackProcStr(ByVal hWnd As Long, _ 
         ByVal uMsg As Long, _ 
         ByVal lParam As Long, _ 
         ByVal lpData As Long) As Long 
         
         'Callback for the Browse STRING method. 
         
         'On initialization, set the dialog's 
         'pre-selected folder from the pointer 
         'to the path allocated as bi.lParam, 
         'passed back to the callback as lpData param. 
         
         Select Case uMsg 
         Case BFFM_INITIALIZED 
         
         Call SendMessage(hWnd, BFFM_SETSELECTIONA, _ 
         True, ByVal StrFromPtrA(lpData)) 
         
         Case Else: 
         
         End Select 
         
        End Function 
         
         
        Public Function BrowseCallbackProc(ByVal hWnd As Long, _ 
         ByVal uMsg As Long, _ 
         ByVal lParam As Long, _ 
         ByVal lpData As Long) As Long 
         
         'Callback for the Browse PIDL method. 
         
         'On initialization, set the dialog's 
         'pre-selected folder using the pidl 
         'set as the bi.lParam, and passed back 
         'to the callback as lpData param. 
         
         Select Case uMsg 
         Case BFFM_INITIALIZED 
         
         Call SendMessage(hWnd, BFFM_SETSELECTIONA, _ 
         False, ByVal lpData) 
         
         Case Else: 
         
         End Select 
         
        End Function 
         
         
        Public Function FARPROC(pfn As Long) As Long 
         
         'A dummy procedure that receives and returns 
         'the value of the AddressOf operator. 
         
         'Obtain and set the address of the callback 
         'This workaround is needed as you can't assign 
         'AddressOf directly to a member of a user- 
         'defined type, but you can assign it to another 
         'long and use that (as returned here) 
         
         FARPROC = pfn 
         
        End Function 
         
         
        Public Function StrFromPtrA(lpszA As Long) As String 
         
         'Returns an ANSI string from a pointer to an ANSI string. 
         
         Dim sRtn As String 
         sRtn = String$(lstrlenA(ByVal lpszA), 0) 
         Call lstrcpyA(ByVal sRtn, ByVal lpszA) 
         StrFromPtrA = sRtn 
         
        End Function 
         
        '--end block--' 
        将下面代码加入窗体。窗体上还应放置三个按钮和两个TextBox。 
        Option Explicit 
         
        Private Sub cmdString_Click() 
         
         Text2 = "" 
         Text2 = BrowseForFolderByPath((Text1)) 
         
        End Sub 
         
         
        Private Sub cmdPIDL_Click() 
         
         Text2 = "" 
         Text2 = BrowseForFolderByPIDL((Text1)) 
         
        End Sub 
         
         
        Private Sub cmdEnd_Click() 
         
         Unload Me 
         
        End Sub 
         
         
        Public Function BrowseForFolderByPath(sSelPath As String) As String 
         
         Dim BI As BROWSEINFO 
         Dim pidl As Long 
         Dim lpSelPath As Long 
         Dim sPath As String * MAX_PATH 
         
         With BI 
         .hOwner = Me.hWnd 
         .pidlRoot = 0 
         .lpszTitle = "Pre-selecting the folder using the folder's string." 
         .lpfn = FARPROC(AddressOf BrowseCallbackProcStr) 
         
         lpSelPath = LocalAlloc(LPTR, Len(sSelPath)) 
         MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath) 
         .lParam = lpSelPath 
         
         End With 
         
         pidl = SHBrowseForFolder(BI) 
         
         If pidl Then 
         
         If SHGetPathFromIDList(pidl, sPath) Then 
         BrowseForFolderByPath = Left$(sPath, InStr(sPath, vbNullChar) - 1) 
         End If 
         
         Call CoTaskMemFree(pidl) 
         
         End If 
         
         Call LocalFree(lpSelPath) 
         
        End Function 
         
         
        Public Function BrowseForFolderByPIDL(sSelPath As String) As String 
         
         Dim BI As BROWSEINFO 
         Dim pidl As Long 
         Dim sPath As String * MAX_PATH 
         
         With BI 
         .hOwner = Me.hWnd 
         .pidlRoot = 0 
         .lpszTitle = "Pre-selecting a folder using the folder's pidl." 
         .lpfn = FARPROC(AddressOf BrowseCallbackProc) 
         .lParam = SHSimpleIDListFromPath(sSelPath) 
         End With 
         
         pidl = SHBrowseForFolder(BI) 
         
         If pidl Then 
         If SHGetPathFromIDList(pidl, sPath) Then 
         BrowseForFolderByPIDL = Left$(sPath, InStr(sPath, vbNullChar) - 1) 
         End If 
         
         Call CoTaskMemFree(pidl) 
         End If 
         
         Call CoTaskMemFree(BI.lParam) 
         
        End Function 
        你也可以从http://www.mvp.org/ccrp下载BrowseDialog控件,它可以完成同样的工作。 
      

  3.   

    把这个改成 DLL 再到98下试试,看看行不?我没有测试过...
    测试后希望楼主说下,看看行不?