Public Sub ShellDoc(strFile As String)
'默认程序打开文件,无则调用打开方式
Dim lngRet As Long
Dim strDir As String
lngRet = ShellExecute(GetDesktopWindow, "open", strFile, vbNullString, vbNullString, vbNormalFocus)
If lngRet = SE_ERR_NOASSOC Then
' 没有关联的程序
strDir = Space(260)
lngRet = GetSystemDirectory(strDir, Len(strDir))
strDir = Left(strDir, lngRet)
' 显示打开方式窗口
Call ShellExecute(GetDesktopWindow, vbNullString, "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL " & strFile, strDir, vbNormalFocus)
End If
End Sub
'默认程序打开文件,无则调用打开方式
Dim lngRet As Long
Dim strDir As String
lngRet = ShellExecute(GetDesktopWindow, "open", strFile, vbNullString, vbNullString, vbNormalFocus)
If lngRet = SE_ERR_NOASSOC Then
' 没有关联的程序
strDir = Space(260)
lngRet = GetSystemDirectory(strDir, Len(strDir))
strDir = Left(strDir, lngRet)
' 显示打开方式窗口
Call ShellExecute(GetDesktopWindow, vbNullString, "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL " & strFile, strDir, vbNormalFocus)
End If
End Sub
Microsoft Common Dialog Control 6.0就可以添加了!
打开窗口命令:
commondialog1.showopen
还有好多参数你慢慢调试吧
CommonDialog1.ShowOpen
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 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 TypePublic Const OFN_HIDEREADONLY = &H4 '隐藏只读打开
Public Const OFN_READONLY = &H1 '只读打开为选中
Public Const OFN_OVERWRITEPROMPT = &H2 '覆盖时提示
Public Const OFN_ALLOWMULTISELECT = &H200 '多个选中
Public Const OFN_EXPLORER = &H80000 '资源管理器Public Function ShowOpen(MehWnd As Long, _
FileOpen As String, _
Optional Title As String = "打开:", _
Optional Filter As String = vbNullChar + vbNullChar, _
Optional FilterIndex As Long = 0, _
Optional StartDir As String = vbNullChar, _
Optional flags As Long = OFN_HIDEREADONLY) As Long
Dim OpenFN As OPENFILENAME
Dim Rc As Long
With OpenFN
.hwndOwner = MehWnd
.hInstance = App.hInstance
.lpstrTitle = Title
.lpstrFilter = Filter
.nFilterIndex = FilterIndex
.lpstrInitialDir = StartDir
.lpstrFile = String$(256, 0)
.nMaxFile = 255
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = 255
.flags = flags
.lStructSize = Len(OpenFN)
End With
Rc = GetOpenFileName(OpenFN)
If Rc Then
FileOpen = Left$(OpenFN.lpstrFile, OpenFN.nMaxFile)
ShowOpen = True
Else
ShowOpen = False
End If
End FunctionPublic Function ShowSave(MehWnd As Long, _
FileSave As String, _
Optional Title As String = "保存:", _
Optional Filter As String = vbNullChar + vbNullChar, _
Optional FilterIndex As Long = 0, _
Optional StartDir As String = vbNullChar, _
Optional flags As Long = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT) As Long
Dim SaveFN As OPENFILENAME
Dim Rc As Long
With SaveFN
.hwndOwner = MehWnd
.hInstance = App.hInstance
.lpstrTitle = Title
.lpstrFilter = Filter
.nFilterIndex = FilterIndex
.lpstrInitialDir = StartDir
.lpstrFile = FileSave + String$(255, Chr$(0))
.nMaxFile = Len(.lpstrFile)
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = 255
.flags = flags
.lStructSize = Len(SaveFN)
End With
Rc = GetSaveFileName(SaveFN)
If Rc Then
FileSave = Left$(SaveFN.lpstrFile, SaveFN.nMaxFile)
ShowSave = True
Else
ShowSave = False
End If
End Function
这个控件在Components属性页里叫:Microsoft Common Dialog Control 6.0
找一下吧:)
CommonDialog1.ShowOpen
CommonDialog1.ShowSave
CommonDialog1.ShowColor
CommonDialog1.ShowFont
CommonDialog1.ShowHelp
CommonDialog1.ShowPrinter
'默认程序打开文件,无则调用打开方式
Dim lngRet As Long
Dim strDir As String
lngRet = ShellExecute(GetDesktopWindow, "open", strFile, vbNullString, vbNullString, vbNormalFocus)
If lngRet = SE_ERR_NOASSOC Then
' 没有关联的程序
strDir = Space(260)
lngRet = GetSystemDirectory(strDir, Len(strDir))
strDir = Left(strDir, lngRet)
' 显示打开方式窗口
Call ShellExecute(GetDesktopWindow, vbNullString, "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL " & strFile, strDir, vbNormalFocus)
End If
End Sub