---------------------------------------------------------------------
双击的时候：如果是未知类型的文件，会跳出“请选择打开方式“对话框
---------------------------------------------------------------------
用ShellExecute,如果是未知类型的文件，没反应。
---------------------------------------------------------------------
请高手检验一下，在D:盘新建一个 1.abc,然后
执行 openfile(me.hwnd,"d:\1.abc"),没反应。而双击就不同，会跳出“请选择打开方式“对话框。在一个涉及到文件管理程序中用到，很是令我头疼，请赐教，谢谢了。
代码：-----------------------------------------------------------------------------------------
Option ExplicitPrivate Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Const SW_SHOWNORMAL = 1Public Function OpenFile(ByVal hWnd As Long, ByVal sFQFilename As String) As Long
OpenFile = ShellExecute(hWnd, "open", sFQFilename, vbNullString, vbNullString, SW_SHOWNORMAL)
End FunctionPublic Function OpenFile2(ByVal hWnd As Long, ByVal sFQFilename As String) As Long
OpenFile2 = ShellExecute(hWnd, vbNullString, sFQFilename, vbNullString, vbNullString, SW_SHOWNORMAL)
End FunctionPublic Function OpenFile3(ByVal hWnd As Long, ByVal sFQFilename As String) As Long
OpenFile3 = ShellExecute(hWnd, "explorer", sFQFilename, vbNullString, vbNullString, SW_SHOWNORMAL)
End Function
------------------------------------------------------------------------------------------------
Private Declare Function ShellExecute Lib _
"shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function GetSystemDirectory Lib _
"kernel32" Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize _
As Long) As Long
Private Const SE_ERR_NOASSOC = 31
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 SubPrivate Sub Command1_Click()
ShellDoc "c:\1.csv.bak"
End Sub
Private Sub Command1_Click()
MsgBox getfilePTY("C:\test.xxx")
End SubFunction getfilePTY(strFl As String) As String
Dim fso 'As FileSystemObject
Dim fl 'As Scripting.File
Dim pth As String
Dim flname As StringDim shl As Shell32.Shell
Dim shfd As Shell32.Folder
Dim s As String
Dim itm'Set fso = New FileSystemObject
Set fso = CreateObject("scripting.filesystemobject")
Set fl = fso.GetFile(strFl)
pth = fl.ParentFolder.Path
flname = fl.NameSet shl = New Shell
Set shfd = shl.Namespace(pth)
For Each itm In shfd.Items.Item(flname).Verbs
s = s & itm.Name & Chr(10)
'If itm.Name = "打开(&O)" Then itm.DoIt
If itm.Name = "属性(&R)" Then itm.DoIt
Next
getfilePTY = s
End Function
Option Explicit
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" _
(SEI As SHELLEXECUTEINFO) As Long
Public Function ShowProperties(FileName As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
Dim r As Long
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = FileName
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
r = ShellExecuteEX(SEI)
ShowProperties = SEI.hInstApp
End Function
in form:
Private Sub Command1_Click()
Dim r As Long
Dim FileName As String
FileName = "D:\VB archives\系统功能\获得text中的行数\工程1.vbp"
r = ShowProperties(FileName, Me.hwnd)
If r <= 32 Then MsgBox "Error"
End Sub