VB6 CommonDialog初始路径第二次打开会失效

Question

生成为exe后，第一次打开是X盘，但是比如我打开后选择了D盘的excel，之后打开程序就会默认跑到D盘而不是X盘，怎么把他固定下来。以下是具体代码，操作系统是server 2012CommonDialog1.MaxFileSize = 32767
CommonDialog1.InitDir = "X:\"
CommonDialog1.Filter = "Excel(*.xls)|*.xls"
CommonDialog1.Flags = cdlOFNExplorer
CommonDialog1.FileName = ""
CommonDialog1.ShowOpenErase a, b
If CommonDialog1.FileName <> "" Then
  a = Split(CommonDialog1.FileName, Chr(0))
  b = Split(CommonDialog1.FileTitle, Chr(0))
  End If

Answer 1

CommonDialog1.FileName = ""
CommonDialog1.InitDir = "X:\"
把这两句换成这个顺序就好了

Answer 2

打开过一次之后 CommonDialog1.FileName 有值了，CommonDialog1.FileName优先于CommonDialog1.InitDir确定了初始打开的文件夹位置。

Answer 3

我用API的，也发现编译后的exe，自己设置的 InitDir不起作用，　似乎“系统保存”的信息才是决定因素。但不知为什么，在IDE中运行，始终是有效的。

Answer 4

CommonDialog1.FileName不留空，
把 CommonDialog1.FileName 当默认文件名用比如 CommonDialog1.FileName=“X:\*.xls”

Answer 5

我发现问题了： InitDir 的“路径”，必须要以 “\”结束才能生效。
以前总是发现“设置路径”后不起作用，莫明其妙的…………
我是用API的，用CommonDialog的也可以参考，试一下。

Answer 6

你就不能判断一下吗？如果是 App.Path ，当Len(App.Path)为3，则是根目录，不用增加；否则增加一个。
如果是“其它来源”的路径，直接判断最后一个字符是不是 \ 啊，不是就加上；是就不管了。

Answer 7

当然，“判断最后一个字符是不是 \ ”的方法，对App.Path 也同样可用。
只不过 App.Path 直接用 Len( )来判断，代码简单点，运行效率也高点。

Answer 8

不是Len判断的问题，根目录的时候InitDir \结尾也不起作用

Answer 9

不是Len判断的问题，根目录的时候InitDir \结尾也不起作用
我刚才试了根目录，照样完全正常。只要是“存在的、有效的目录，并且给定目录是以1个\结尾的”，无论是否为根目录，都是正常的。

Answer 10

看来还是和api有差别，我一直用c:\在试，不行的

Answer 11

我的 E:\　D:\　C:\ 　F:\ 都试了，在IDE中运行、编译后运行都正常。
C:盘是系统盘。你再试试：　目录 \ 后再加个 vbNullChar 
比如，　CommonDialog1.InitDir = "C:\" & vbNullChar

Answer 12

我的 E:\　D:\　C:\ 　F:\ 都试了，在IDE中运行、编译后运行都正常。
C:盘是系统盘。你再试试：　目录 \ 后再加个 vbNullChar 
比如，　CommonDialog1.InitDir = "C:\" & vbNullChar

诡异的现象，突然就好了，加不加\已经无所谓了，就是好的，你试试看。

Answer 13

写一下我的测试过程
1.新建空工程，加一个CommonDialog1和一个Command1，代码如下Private Sub Command1_Click()
    CommonDialog1.InitDir = "c:\"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    Me.Caption = CommonDialog1.FileName
End Sub
编译后运行，结果，不行
然后改代码Private Sub Command1_Click()
    CommonDialog1.InitDir = app.path & "\"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    Me.Caption = CommonDialog1.FileName
End Sub
编译后运行，可以
然后，你再用 app.path 或者 c:\ 都 好了

Answer 14

在我的这儿，这事从来没有出现过“诡异现象”。
有几个小程序，一直在“偶尔用下”，持续2、3年了吧。
有的是设置了路径的（都是app.path，非根目录，最后没带 \ 的），也有的是设置为NULL的（相当于“没设置”）
　都是一样的反应：初始路径似乎由“系统记忆”来决定的。你的 CommonDialog1.Flag 没有设置吧？（控件按不同的“对话框类型”有不同的默认值）
我的“打开文件”的是 &H1804 。
不知道你的“突然好了”，是否是改变对话框的路径后，选择某文件“打开”了呢？
如果你是“取消”的话，即使改变了路径，“系统的记忆”也不会改变的，跟“之前的”一样。
因此，如果是“取消”，有可能造成误导。

Answer 15

代码我都贴上边了，别的参数没了，问题可以重现，新建出来的工程就这样，编译两次好了，win10+VB6mini

Answer 16

不稳定的根是Win10，我猜。

Answer 17

我一直觉得这个控件不正常，所以我一直都是用API的

Answer 18

API怎么调用，有教程吗

Answer 19

API怎么调用，有教程吗

Answer 20

API怎么调用，有教程吗
要“教程”，查MSDN、或者百度啊……给你一段简单使用的代码参考：
这只是打开“单个文件”用的，当然它也跟 CommonDialog控件一样，
　　只返回了选择的文件（完整路径），并没有真正“打开文件”（显然不可能执行真正的打开操作）。
Option Explicit
' -= 文件对话框 =-
Private Declare Function GetOpenFileName Lib "Comdlg32" Alias "GetOpenFileNameW" ( _
                           ByRef pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "Comdlg32" Alias "GetSaveFileNameW" ( _
                           ByRef pOpenfilename As OPENFILENAME) As Long
' * * *  打开/保存 文件API用数据类型  * * *
Private Type OPENFILENAME
    lStructSize      As Long
    hWndOwner        As Long
    hInstance        As Long
    lpstrFilter      As Long
    lpstrCustFilter  As Long
    nMaxCustFilter   As Long
    nFilterIndex     As Long
    lpstrFile        As Long
    nMaxFile         As Long
    lpstrFileTitle   As Long
    nMaxFileTitle    As Long
    lpstrInitialDir  As Long
    lpstrTitle       As Long
    Flags            As Long
    nFileOffset      As Integer
    nFileExtension   As Integer
    lpstrDefExt      As Long
    lCustData        As Long
    lpfnHook         As Long
    lpTemplateName   As Long
End Type
Private Function ShowOpen(ByVal Title As String, ByVal Filter As String, _
                           ByRef FileOpen As String) As Long
   Dim OpenFN  As OPENFILENAME
   Dim strFilt As String
   Dim strPath As String
   Dim strName As String
   Dim strTemp As String   strName = String$(264&, 0)
   strTemp = strName
   strPath = App.Path & "\" & vbNullChar
   strFilt = Replace(Replace(Filter & vbNullChar, "|", vbNullChar), ",", vbNullChar)
   OpenFN.lStructSize = 76&   ' LenB(OpenFN)
   OpenFN.hWndOwner = Me.hWnd
   OpenFN.hInstance = App.hInstance
   OpenFN.lpstrTitle = StrPtr(Title)
   OpenFN.lpstrFilter = StrPtr(strFilt)
   OpenFN.nFilterIndex = 0&
   OpenFN.lpstrDefExt = 5& + StrPtr(strFilt) + InStrB(1&, Filter, "|")        ' 第一种类型的扩展名
   OpenFN.lpstrInitialDir = StrPtr(strPath)
   OpenFN.lpstrFile = StrPtr(strName)
   OpenFN.nMaxFile = 256&
   OpenFN.lpstrFileTitle = StrPtr(strTemp)
   OpenFN.nMaxFileTitle = 256&
   OpenFN.Flags = &H180C&
   If (GetOpenFileName(OpenFN)) Then
      Dim p As Long
      p = InStr(1&, strName, vbNullChar)
      FileOpen = Left$(strName, p - 1&)
      ShowOpen = vbFalse
   Else
      ShowOpen = vbTrue
   End If
End FunctionPrivate Sub Command1_Click()
   Dim strFile As String   If (ShowOpen("打开文件", "所有文件（*.*）|*.*,", strFile)) Then Exit Sub
   Call MsgBox(strFile, 64&)
End Sub

Answer 21

分两截贴吧
Option ExplicitPrivate Declare Sub CopyMem Lib "KERNEL32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
Private Declare Sub CopyMemByPtr Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
Private Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "KERNEL32" Alias "lstrlenA" (ByVal lpString As Any) As Long
'**********************************************************
''定义一个全局变量,用于保存字体的各种属性
Public Type SmFontAttr
  FontName As String       '字体名
  FontSize As Integer      '字体大小
  FontBod As Boolean       '是否黑体
  FontItalic As Boolean    '是否斜体
  FontUnderLine As Boolean '是否下划线
  FontStrikeou As Boolean
  FontColor As Long
  WinHwnd As Long
End Type
Dim M_GetFont As SmFontAttrPrivate Const LF_FACESIZE = 32
Private Const MAX_PATH = 260
Private Const CF_INITTOLOGFONTSTRUCT = &H40
Private Const CF_FIXEDPITCHONLY = &H4000
Private Const CF_EFFECTS = &H100Private Const CF_SHOWHELP = &H4'/------------------------------------------
Private Type CHOOSECOLOR
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        rgbResult As Long
        lpCustColors As String
        flags As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
'/-----------------------------------------------------------
Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * LF_FACESIZE
End Type
Private Type CHOOSEFONT
        lStructSize As Long
        hwndOwner As Long
        hdc As Long
        lpLogFont As Long
        iPointSize As Long
        flags As Long
        rgbColors As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
        hInstance As Long
        lpszStyle As String
        nFontType As Integer
        MISSING_ALIGNMENT As Integer
        nSizeMin As Long
        nSizeMax As Long
 End Type
'/--------------
Private Type SHITEMID
    cb As Long
    abID() As Byte
End Type
Private Type ITEMIDLIST
     mkid As SHITEMID
End Type
'/------------------------------------------
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                              (ByVal Pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                              (ByVal hwndOwner As Long, ByVal nFolder As Long, _
                               Pidl As ITEMIDLIST) As Long
'/------------------------------------------
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChooseFont As CHOOSEFONT) As Long
'/=======显示断开网络资源对话框============
Private Declare Function WNetDisconnectDialog Lib "mpr.dll" _
      (ByVal hWnd As Long, ByVal dwType As Long) As Long
'/================================================================================
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
                                               (lpBrowseInfo As BROWSEINFO) As Long
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 Type
'/结构说明: _
          hOwner 调用这个对话框的窗口的句柄 _
          pidlRoot 指向你希望浏览的最上面的文件夹的符列表 _
          pszDisplayName 用于保存用户所选择的文件夹的显示名的缓冲区 _
          lpszTitle 浏览对话框的标题 _
          ulFlags  决定浏览什么的标志(见下) _
          lpfn  当事件发生时对话框调用的回调函数的地址.可将它设定为NULL _
          lparam 若定义了回调函数,则为传递给回调函数的值 _
          iImage As Long  保存所选文件夹映像索引的缓冲区 _
ulFlags参数(见下:)
Private Const BIF_RETURNONLYFSDIRS = &H1     '仅允许浏览文件系统文件夹
Private Const BIF_DONTGOBELOWDOMAIN = &H2    '利用这个值强制用户仪在网上邻居的域级别中
Private Const BIF_STATUSTEXT = &H4           '在选择对话中显示状态栏
Private Const BIF_RETURNFSANCESTORS = &H8    '返回文件系统祖先
Private Const BIF_BROWSEFORCOMPUTER = &H1000 '允许浏览计算机
Private Const BIF_BROWSEFORPRINTER = &H2000  '允许游览打印机文件夹
'/--------------------------------------------------------------------------------
Private Function GetFolderValue(wIdx As Integer) As Long
    If wIdx < 2 Then
      GetFolderValue = 0
    ElseIf wIdx < 12 Then
      GetFolderValue = wIdx
    Else
      GetFolderValue = wIdx + 4
    End If
End Function

Answer 22

第二截，其中有一个函数被我整体注释掉了，应该是当时有点啥问题，因为没用到于是懒得查问题直接注释掉。'
'文件夹选择对话框
'函数:SaveFile
'参数:Title    设置对话框的标签.
'     hWnd     调用此函数的HWND
'     FolderID SmBrowFolder枚举(默认:我的电脑).
'返回值:String 文件夹路径.
'例子：
'Public Function GetFolder(Optional Title As String, _
'                          Optional hWnd As Long, _
'                          Optional FolderID As SmBrowFolder = MyComputer) As String
'  Dim Bi As BROWSEINFO
'  Dim Pidl As Long
'  Dim Folder As String
'  Dim IDL As ITEMIDLIST
'  Dim nFolder As Long
'  Dim ReturnFol As String
'  Dim Fid As Integer
'
'  Fid = FolderID
'  Folder = String$(255, Chr$(0))
'  With Bi
'       .hOwner = hWnd
'       nFolder = GetFolderValue(Fid)
'       If SHGetSpecialFolderLocation(ByVal hWnd, ByVal nFolder, IDL) = NoError Then
'          .pidlRoot = IDL.mkid.cb
'       End If
'       .pszDisplayName = String$(MAX_PATH, Fid)
'
'       If Len(Title) > 0 Then
'         .lpszTitle = Title & Chr$(0)
'       Else
'         .lpszTitle = "请选择文件夹:" & Chr$(0)
'       End If
'
'      .ulFlags = GetReturnType()
'  End With
'
'  Pidl = SHBrowseForFolder(Bi)
'  '/返回所选的文件夹路径
'  If SHGetPathFromIDList(ByVal Pidl, ByVal Folder) Then
'     ReturnFol = Left$(Folder, InStr(Folder, Chr$(0)) - 1)
'     If Right$(Trim$(ReturnFol), 1) <> "/" Then ReturnFol = ReturnFol & "/"
'     GetFolder = ReturnFol
'  Else
'    GetFolder = ""
'  End If
'End Function
'
'文件保存对话框
'函数:SaveFile
'参数:WinHwnd   调用此函数的HWND
'     BoxLabel  设置对话框的标签.
'     StartPath 设置初始化路径.
'     FilterStr 文件过滤.
'     Flag      标志.(参考MSDN)
'返回值:String 文件名.
'例子：
Public Function SaveFile(WinHwnd As Long, _
                         Optional BoxLabel As String = "", _
                         Optional StartPath As String = "", _
                         Optional FilterStr = "*.*|*.*", _
                         Optional Flag As Variant = &H4 Or &H200000) As String
  Dim rc As Long
  Dim pOpenfilename As OPENFILENAME
  Dim Fstr1() As String
  Dim Fstr As String
  Dim i As Long
  Const MAX_Buffer_LENGTH = 256
  
  On Error Resume Next
  
  If Len(Trim$(StartPath)) > 0 Then
     If Right$(StartPath, 1) <> "/" Then StartPath = StartPath & "/"
     If Dir$(StartPath, vbDirectory + vbHidden) = "" Then
        StartPath = App.Path
     End If
  Else
     StartPath = App.Path
  End If
  If Len(Trim$(FilterStr)) = 0 Then
     Fstr = "*.*|*.*"
  End If
  Fstr1 = Split(FilterStr, "|")
  For i = 0 To UBound(Fstr1)
      Fstr = Fstr & Fstr1(i) & vbNullChar
  Next
  '/--------------------------------------------------
  With pOpenfilename
       .hwndOwner = WinHwnd
       .hInstance = App.hInstance
       .lpstrTitle = BoxLabel
       .lpstrInitialDir = StartPath
       .lpstrFilter = Fstr
       .nFilterIndex = 1
       .lpstrDefExt = vbNullChar & vbNullChar
       .lpstrFile = String(MAX_Buffer_LENGTH, 0)
       .nMaxFile = MAX_Buffer_LENGTH - 1
       .lpstrFileTitle = .lpstrFile
       .nMaxFileTitle = MAX_Buffer_LENGTH
       .lStructSize = Len(pOpenfilename)
       .flags = Flag
  End With
  rc = GetSaveFileName(pOpenfilename)
  If rc Then
     SaveFile = Left$(pOpenfilename.lpstrFile, pOpenfilename.nMaxFile)
  Else
    SaveFile = ""
  End If
End Function
'
'文件打开对话框
'函数:OpenFile
'参数:WinHwnd   调用此函数的HWND
'     BoxLabel  设置对话框的标签.
'     StartPath 设置初始化路径.
'     FilterStr 文件过滤.
'     Flag      标志.(参考MSDN)
'返回值:String 文件名.
'例子：
Public Function MyOpenFile(WinHwnd As Long, _
                         Optional BoxLabel As String = "", _
                         Optional StartPath As String = "", _
                         Optional FilterStr = "*.*|*.*", _
                         Optional Flag As Variant = &H8 Or &H200000) As String
  Dim rc As Long
  Dim pOpenfilename As OPENFILENAME
  Dim Fstr1() As String
  Dim Fstr As String
  Dim i As Long
  Const MAX_Buffer_LENGTH = 256
  
  On Error Resume Next
  
  If Len(Trim$(StartPath)) > 0 Then
     If Right$(StartPath, 1) <> "/" Then StartPath = StartPath & "/"
     If Dir$(StartPath, vbDirectory + vbHidden) = "" Then
        StartPath = App.Path
     End If
  Else
     StartPath = App.Path
  End If
  If Len(Trim$(FilterStr)) = 0 Then
     Fstr = "*.*|*.*"
  End If
  Fstr = ""
  Fstr1 = Split(FilterStr, "|")
  For i = 0 To UBound(Fstr1)
      Fstr = Fstr & Fstr1(i) & vbNullChar
  Next
  With pOpenfilename
       .hwndOwner = WinHwnd
       .hInstance = App.hInstance
       .lpstrTitle = BoxLabel
       .lpstrInitialDir = StartPath
       .lpstrFilter = Fstr
       .nFilterIndex = 1
       .lpstrDefExt = vbNullChar & vbNullChar
       .lpstrFile = String(MAX_Buffer_LENGTH, 0)
       .nMaxFile = MAX_Buffer_LENGTH - 1
       .lpstrFileTitle = .lpstrFile
       .nMaxFileTitle = MAX_Buffer_LENGTH
       .lStructSize = Len(pOpenfilename)
       .flags = Flag
  End With
  rc = GetOpenFileName(pOpenfilename)
  If rc Then
     MyOpenFile = Left$(pOpenfilename.lpstrFile, pOpenfilename.nMaxFile)
  Else
     MyOpenFile = ""
  End If
End Function
'
'颜色对话框
'函数:GetColor
'参数:
'返回值:Long,用户所选择的颜色.
'例子：
Public Function GetColor() As Long
  Dim rc As Long
  Dim pChoosecolor As CHOOSECOLOR
  Dim CustomColor() As Byte
  With pChoosecolor
       .hwndOwner = 0
       .hInstance = App.hInstance
       .lpCustColors = StrConv(CustomColor, vbUnicode)
       .flags = 0
       .lStructSize = Len(pChoosecolor)
  End With
  rc = CHOOSECOLOR(pChoosecolor)
  If rc Then
        GetColor = pChoosecolor.rgbResult
  Else
        GetColor = -1
  End If
End Function

Answer 23

我试了一下你这个“注释掉”的函数，主要有两个问题：
1.　缺少 SmBrowFolder 这个枚举类型的定义。
2.　缺少 GetReturnType() 这个函数定义。我把函数参数 FolderID 类型改为 Long 类型、　再把.ulFlags = GetReturnType()　改为 .ulFlags = 0
　　调用时， FolderID参数值传13或0，就可以了。不过，我以前就有这个“选择文件夹”的封装函数，要比你的这段代码简单些。