生成為exe后，第一次打開是X盤，但是比如我打開后選擇了D盤的excel，之后打開程式就會默認跑到D盤而不是X盤，怎么把他固定下來。
以下是具體代碼，作業系統是server 2012
CommonDialog1.MaxFileSize = 32767
CommonDialog1.InitDir = "X:\"
CommonDialog1.Filter = "Excel(*.xls)|*.xls"
CommonDialog1.Flags = cdlOFNExplorer
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
Erase a, b
If CommonDialog1.FileName <> "" Then
a = Split(CommonDialog1.FileName, Chr(0))
b = Split(CommonDialog1.FileTitle, Chr(0))
End If
uj5u.com熱心網友回復：
CommonDialog1.FileName = ""CommonDialog1.InitDir = "X:\"
把這兩句換成這個順序就好了
uj5u.com熱心網友回復：
打開過一次之后 CommonDialog1.FileName 有值了，CommonDialog1.FileName優先于CommonDialog1.InitDir確定了初始打開的檔案夾位置。uj5u.com熱心網友回復：
我用API的，也發現編譯后的exe，自己設定的 InitDir不起作用， 似乎“系統保存”的資訊才是決定因素。但不知為什么，在IDE中運行，始終是有效的。
uj5u.com熱心網友回復：
是啊，發現是編譯之后才出的問題。。。uj5u.com熱心網友回復：
CommonDialog1.FileName不留空，把 CommonDialog1.FileName 當默認檔案名用
比如 CommonDialog1.FileName=“X:\*.xls”
uj5u.com熱心網友回復：
我發現問題了： InitDir 的“路徑”，必須要以 “\”結束才能生效。
以前總是發現“設定路徑”后不起作用，莫明其妙的…………
我是用API的，用CommonDialog的也可以參考，試一下。
uj5u.com熱心網友回復：
，不過根目錄怎么辦？兩個\好象也還是不行啊
uj5u.com熱心網友回復：
你就不能判斷一下嗎？如果是 App.Path ，當Len(App.Path)為3，則是根目錄，不用增加；否則增加一個。
如果是“其它來源”的路徑，直接判斷最后一個字符是不是 \ 啊，不是就加上；是就不管了。
uj5u.com熱心網友回復：
當然，“判斷最后一個字符是不是 \ ”的方法，對App.Path 也同樣可用。只不過 App.Path 直接用 Len( )來判斷，代碼簡單點，運行效率也高點。
uj5u.com熱心網友回復：
不是Len判斷的問題，根目錄的時候InitDir \結尾也不起作用
uj5u.com熱心網友回復：
我剛才試了根目錄，照樣完全正常。
只要是“存在的、有效的目錄，并且給定目錄是以1個\結尾的”，無論是否為根目錄，都是正常的。
uj5u.com熱心網友回復：
看來還是和api有差別，我一直用c:\在試，不行的uj5u.com熱心網友回復：
我的 E:\ D:\ C:\ F:\ 都試了，在IDE中運行、編譯后運行都正常。
C:盤是系統盤。
你再試試： 目錄 \ 后再加個 vbNullChar
比如， CommonDialog1.InitDir = "C:\" & vbNullChar
uj5u.com熱心網友回復：
詭異的現象，突然就好了，加不加\已經無所謂了，就是好的，你試試看。
uj5u.com熱心網友回復：
寫一下我的測驗程序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:\ 都 好了
uj5u.com熱心網友回復：
在我的這兒，這事從來沒有出現過“詭異現象”。
有幾個小程式，一直在“偶爾用下”，持續2、3年了吧。
有的是設定了路徑的（都是app.path，非根目錄，最后沒帶 \ 的），也有的是設定為NULL的（相當于“沒設定”）
都是一樣的反應：初始路徑似乎由“系統記憶”來決定的。
你的 CommonDialog1.Flag 沒有設定吧？（控制元件按不同的“對話框型別”有不同的默認值）
我的“打開檔案”的是 &H1804 。
不知道你的“突然好了”，是否是改變對話框的路徑后，選擇某檔案“打開”了呢？
如果你是“取消”的話，即使改變了路徑，“系統的記憶”也不會改變的，跟“之前的”一樣。
因此，如果是“取消”，有可能造成誤導。
uj5u.com熱心網友回復：
昨天偶然想到“路徑加 \ ”的問題。然后才發現，終于能“按我的想法來設定初始路徑”了。
uj5u.com熱心網友回復：
代碼我都貼上邊了，別的引數沒了，問題可以重現，新建出來的工程就這樣，編譯兩次好了，win10+VB6miniuj5u.com熱心網友回復：
我的以前寫好的程式中，有“設定了路徑”的，但從來沒有起到過作用。顯然： 不能“重現”的那兒的情況。
再說了，你那兒一會兒這種狀態、一會兒那種狀態，這么“靈異”的事情，能作為“通用”方法嗎！
我的是“路徑以1個 \ 結尾”，就一定有效，這樣的才“通用”啊。
uj5u.com熱心網友回復：
不穩定的根是Win10，我猜。uj5u.com熱心網友回復：
我一直覺得這個控制元件不正常，所以我一直都是用API的uj5u.com熱心網友回復：
API怎么呼叫，有教程嗎
uj5u.com熱心網友回復：
API怎么呼叫，有教程嗎
uj5u.com熱心網友回復：
要“教程”，查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 Function
Private Sub Command1_Click()
Dim strFile As String
If (ShowOpen("打開檔案", "所有檔案（*.*）|*.*,", strFile)) Then Exit Sub
Call MsgBox(strFile, 64&)
End Sub
uj5u.com熱心網友回復：
想貼個模塊，居然超過發帖限制uj5u.com熱心網友回復：
分兩截貼吧
Option Explicit
Private 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 SmFontAttr
Private Const LF_FACESIZE = 32
Private Const MAX_PATH = 260
Private Const CF_INITTOLOGFONTSTRUCT = &H40
Private Const CF_FIXEDPITCHONLY = &H4000
Private Const CF_EFFECTS = &H100
Private 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
uj5u.com熱心網友回復：
第二截，其中有一個函式被我整體注釋掉了，應該是當時有點啥問題，因為沒用到于是懶得查問題直接注釋掉。
'
'檔案夾選擇對話框
'函式: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
uj5u.com熱心網友回復：
我試了一下你這個“注釋掉”的函式，主要有兩個問題：
1. 缺少 SmBrowFolder 這個列舉型別的定義。
2. 缺少 GetReturnType() 這個函式定義。
我把函式引數 FolderID 型別改為 Long 型別、 再把.ulFlags = GetReturnType() 改為 .ulFlags = 0
呼叫時， FolderID引數值傳13或0，就可以了。
不過，我以前就有這個“選擇檔案夾”的封裝函式，要比你的這段代碼簡單些。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/45260.html
標籤：控件
下一篇：VB的皮膚問題