就好像关闭选择文件的程序之后,再次重新打开选择窗口,它还会指向原来的文件位置

解决方案 »

  1.   

    用这个模块:Option Explicit'---------------------------------------------------
    '调用 浏览目录 对话框
    '--------------------API声明部分--------------------
    'common to both methods
    Private 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 TypePrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv 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 Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long) '前面已定义Private Const MAX_PATH = 260
    Private Const WM_USER = &H400
    Private Const BFFM_INITIALIZED = 1Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
    Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
    Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
    Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
    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 Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
    Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As LongPrivate Const LMEM_FIXED = &H0
    Private Const LMEM_ZEROINIT = &H40
    Private Const lPtr = (LMEM_FIXED Or LMEM_ZEROINIT)Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const BIF_USENEWUI = &H40Private PreSelFolder As String'-------------------------------------------
    ' 目录选择窗(允许指定初始目录)
    '-------------------------------------------
    Function BrowseForFolder(Optional ByVal sTitle As String, Optional ByVal sSelPath As String, Optional NewFolder As Boolean, Optional ByVal hWndOwner As Long) As String    Dim BI As BROWSEINFO
        Dim pidl As Long
        Dim lpSelPath As Long
        Dim sPath As String * MAX_PATH
        
        If Len(sSelPath) > 0 Then
            sSelPath = Replace(sSelPath & "\", "\\", "\")
        Else
            sSelPath = PreSelFolder
        End If
        
        With BI
            .hOwner = hWndOwner
            .pidlRoot = 0
            .lpszTitle = sTitle
            .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
            
            lpSelPath = LocalAlloc(lPtr, Len(sSelPath))
            MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
            
            .lParam = lpSelPath
            .ulFlags = IIf(NewFolder, BIF_USENEWUI, BIF_RETURNONLYFSDIRS)
        End With
        
        pidl = SHBrowseForFolder(BI)
        
        If pidl Then
            If SHGetPathFromIDList(pidl, sPath) Then
                BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
            End If
            
            Call CoTaskMemFree(pidl)
        End If
        
        Call LocalFree(lpSelPath)
        
        'If cancel was pressed, sPath = ""
        If Len(BrowseForFolder) > 0 Then
            BrowseForFolder = Replace(BrowseForFolder & "\", "\\", "\")
            PreSelFolder = BrowseForFolder
        End IfEnd FunctionPrivate Function BrowseCallbackProcStr(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long    Select Case uMsg
            Case BFFM_INITIALIZED
        
                Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal StrFromPtrA(lpData))
                
            Case Else:
        
        End SelectEnd FunctionPrivate Function FARPROC(ByVal pfn As Long) As Long    FARPROC = pfnEnd FunctionPrivate Function StrFromPtrA(ByVal lpszA As Long) As String    Dim sRtn As String
        
        sRtn = String$(lstrlenA(ByVal lpszA), 0)
        Call lstrcpyA(ByVal sRtn, ByVal lpszA)
        StrFromPtrA = sRtnEnd Function
      

  2.   

    Shell("%SystemRoot%\System32\calc.exe",1)