1、MSComDlg在win7 64位系统应该是可以使用的。
2、以前保存的一个纯api的例子,你参考一下:
Option Explicit
''''''''''''文件打开、保存对话框 开始''''''''''''''''''''''''''
Public 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
Public Const OFN_READONLY As Long = &H1
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_NOREADONLYRETURN As Long = &H8000
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_LONGNAMES As Long = &H200000Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHAREWARN As Long = 0
Public Const MAX_PATH As Long = 260
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) 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 Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_SETSELECTION = (WM_USER + 102)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public m_CurrentDirectory As String 'The current directory
'''''''''''''''''''''打开目录对话框 结束''''''''''''''''''''''''''''''''''''''''''''''''
Public Function MyFileDialog(ByVal bHwnd As Long, ByVal bSaveDialog As Boolean, ByVal bTitle As String, ByVal bFilter As String, Optional bFileName As String, Optional bExtention As String, Optional InitDir As String) As String
On Error Resume Next
Dim OFN As OPENFILENAME
Dim i As Long, w1 As String, w2 As String, ww
If Len(bFileName) > MAX_PATH Then Exit Function ' Call MsgBox("Filename Length Overflow", vbExclamation, App.Title + " - FileDialog Function"): Exit Function
bFileName = bFileName + String(MAX_PATH - Len(bFileName), 0)
With OFN
.lStructSize = Len(OFN)
.hwndOwner = bHwnd ' 0
.hInstance = App.hInstance
.lpstrFilter = Replace(bFilter, "|", vbNullChar)
.lpstrFile = bFileName
.nMaxFile = MAX_PATH
.lpstrFileTitle = Space$(MAX_PATH - 1)
.nMaxFileTitle = MAX_PATH
.lpstrInitialDir = InitDir
.lpstrTitle = bTitle
.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
.lpstrDefExt = bExtention
End With
If bSaveDialog Then
i = GetSaveFileName(OFN)
Else
i = GetOpenFileName(OFN)
End If
If i = 1 Then
w1 = Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile + vbNullChar, vbNullChar) - 1)
If bSaveDialog Then
''如果是保存文件,要检查后缀,并自动完成
ww = Split(bFilter, "|")
w2 = ww((OFN.nFilterIndex - 1) * 2 + 1)
w2 = Right$(w2, Len(w2) - 1)
If LCase$(Right$(w1, Len(w2))) <> LCase$(w2) Then w1 = w1 & w2
End If
MyFileDialog = w1 ''返回结果
End If
End Function
''''''''''''''''''''''''''''''''''''''
Public Function BrowseForFolder(ByVal bHwnd As Long, ByVal bTitle As String, Optional bStartDir As String) As String
On Error Resume Next
'Opens a Treeview control that displays the directories in a computer
Dim lpIDList As Long
Dim szTitle As String
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
m_CurrentDirectory = bStartDir & vbNullChar
szTitle = bTitle
With tBrowseInfo
.hwndOwner = bHwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
Else
BrowseForFolder = ""
End If
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
On Error Resume Next 'Sugested by MS to prevent an error from
Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String
'propagating back into the calling process.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
Case BFFM_SELCHANGED
sBuffer = Space(MAX_PATH)
ret = SHGetPathFromIDList(lp, sBuffer)
If ret = 1 Then
Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
End If
End Select
BrowseCallbackProc = 0
End Function
' This function allows you to assign a function pointer to a vaiable.
Public Function GetAddressofFunction(bAdd As Long) As Long
GetAddressofFunction = bAdd
End Function
2、以前保存的一个纯api的例子,你参考一下:
Option Explicit
''''''''''''文件打开、保存对话框 开始''''''''''''''''''''''''''
Public 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
Public Const OFN_READONLY As Long = &H1
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_NOREADONLYRETURN As Long = &H8000
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_LONGNAMES As Long = &H200000Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHAREWARN As Long = 0
Public Const MAX_PATH As Long = 260
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) 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 Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_SETSELECTION = (WM_USER + 102)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public m_CurrentDirectory As String 'The current directory
'''''''''''''''''''''打开目录对话框 结束''''''''''''''''''''''''''''''''''''''''''''''''
Public Function MyFileDialog(ByVal bHwnd As Long, ByVal bSaveDialog As Boolean, ByVal bTitle As String, ByVal bFilter As String, Optional bFileName As String, Optional bExtention As String, Optional InitDir As String) As String
On Error Resume Next
Dim OFN As OPENFILENAME
Dim i As Long, w1 As String, w2 As String, ww
If Len(bFileName) > MAX_PATH Then Exit Function ' Call MsgBox("Filename Length Overflow", vbExclamation, App.Title + " - FileDialog Function"): Exit Function
bFileName = bFileName + String(MAX_PATH - Len(bFileName), 0)
With OFN
.lStructSize = Len(OFN)
.hwndOwner = bHwnd ' 0
.hInstance = App.hInstance
.lpstrFilter = Replace(bFilter, "|", vbNullChar)
.lpstrFile = bFileName
.nMaxFile = MAX_PATH
.lpstrFileTitle = Space$(MAX_PATH - 1)
.nMaxFileTitle = MAX_PATH
.lpstrInitialDir = InitDir
.lpstrTitle = bTitle
.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
.lpstrDefExt = bExtention
End With
If bSaveDialog Then
i = GetSaveFileName(OFN)
Else
i = GetOpenFileName(OFN)
End If
If i = 1 Then
w1 = Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile + vbNullChar, vbNullChar) - 1)
If bSaveDialog Then
''如果是保存文件,要检查后缀,并自动完成
ww = Split(bFilter, "|")
w2 = ww((OFN.nFilterIndex - 1) * 2 + 1)
w2 = Right$(w2, Len(w2) - 1)
If LCase$(Right$(w1, Len(w2))) <> LCase$(w2) Then w1 = w1 & w2
End If
MyFileDialog = w1 ''返回结果
End If
End Function
''''''''''''''''''''''''''''''''''''''
Public Function BrowseForFolder(ByVal bHwnd As Long, ByVal bTitle As String, Optional bStartDir As String) As String
On Error Resume Next
'Opens a Treeview control that displays the directories in a computer
Dim lpIDList As Long
Dim szTitle As String
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
m_CurrentDirectory = bStartDir & vbNullChar
szTitle = bTitle
With tBrowseInfo
.hwndOwner = bHwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
Else
BrowseForFolder = ""
End If
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
On Error Resume Next 'Sugested by MS to prevent an error from
Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String
'propagating back into the calling process.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
Case BFFM_SELCHANGED
sBuffer = Space(MAX_PATH)
ret = SHGetPathFromIDList(lp, sBuffer)
If ret = 1 Then
Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
End If
End Select
BrowseCallbackProc = 0
End Function
' This function allows you to assign a function pointer to a vaiable.
Public Function GetAddressofFunction(bAdd As Long) As Long
GetAddressofFunction = bAdd
End Function
https://social.technet.microsoft.com/Forums/scriptcenter/en-US/a3b358e8-15ae-4ba3-bca5-ec349df65ef6/windows7-vbscript-open-file-dialog-box-fakepath?forum=ITCG
http://www.qlikcommunity.com/thread/68470
http://demon.tw/programming/vbs-open-file-dialog.html
找过一堆,都没有找到VBS可以用的。还是很谢谢楼上的回复。
应该想问的是:
MSComDlg.CommonDialog调用的是comdlg32
那么,有没有64位的。