100分 控件问题

[li_chengpeng]

各位大虾，小弟本意要打开一个取得文件的对话框

Private Sub Command3_Click()

Dim a As MSComDlg.CommonDialog
Dim str_FilePath

Set a = CreateObject("MSComDlg.CommonDialog")

a.ShowOpen

Label1.Caption = a.FileName

End Sub

其中：
Set a = CreateObject("MSComDlg.CommonDialog")
为什么在一些机器上报错：说控件创建不成功

急。。。。急。。。。急。。。。。

[刘洪峰AIoT]

你直接用API调用，效果更好，根本不用什么控件和引用
Option Explicit
'*************************************************************************
'**类型声明
'*************************************************************************
Type tagOPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

'*************************************************************************
'**变量声明
'*************************************************************************
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
'Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

'*************************************************************************
'**API声明
'*************************************************************************
Private Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

'*************************************************************************
'**函 数 名：TestIt
'**输 入：无
'**输 出：无
'**功能描述：测试
'**全局变量：
'**调用模块：
'**作 者：
'**日 期：2003年04月11日
'**修 改 人：
'**日 期：
'**版 本：版本1.0
'*************************************************************************
Public Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", "*.MDA;*.MDB")
strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")

Call CommDlg(InitialDir:="C:\", Filter:=strFilter, FilterIndex:=3, flags:=lngFlags, DialogTitle:="Hello! Open Me!")
End Function

'*************************************************************************
'**函 数 名：CommDlg
'**输 入：Optional ByRef flags(Variant) - 窗口标志
'** ：Optional ByVal InitialDir(Variant) - 打开的默认目录
'** ：Optional ByVal Filter(Variant) - 文件过滤字符串
'** ：Optional ByVal FilterIndex(Variant) - 个数
'** ：Optional ByVal DefaultExt(Variant) - 默认名称
'** ：Optional ByVal FileName(Variant) - 文件名
'** ：Optional ByVal DialogTitle(Variant) - 标题名
'** ：Optional ByVal hWnd(Variant) - 所在窗口句柄
'** ：Optional ByVal OpenFile(Variant) - 对话框标志
'**输 出：(Variant) -
'**功能描述：打开保存公共对话框
'**全局变量：
'**调用模块：
'**作 者：
'**日 期：2003年04月11日
'**修 改 人：
'**日 期：
'**版 本：版本1.0
'*************************************************************************
Public Function CommDlg(Optional ByVal hwnd As Variant, Optional ByVal DialogTitle As Variant, Optional ByVal Filter As Variant, Optional ByVal FileName As Variant, Optional ByVal OpenFile As Variant, Optional ByVal FilterIndex As Variant, Optional ByVal InitialDir As Variant, Optional ByVal DefaultExt As Variant, Optional ByRef flags As Variant) As Variant
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
'-------------------------------
'各参数默认值判断
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(flags) Then flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = 0 '????????????????????????
If IsMissing(OpenFile) Then OpenFile = True

If Len(Filter) > 0 Then Filter = Replace(Filter, "|", vbNullChar)

'处理文件名
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)

With OFN
.lStructSize = Len(OFN)
.hWndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.flags = flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.strCustomFilter = ""
.nMaxCustFilter = 0
.lpfnHook = 0

'NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With

If OpenFile Then 'open对话框
fResult = aht_apiGetOpenFileName(OFN)
Else 'save对话框
fResult = aht_apiGetSaveFileName(OFN)
End If

If fResult Then
If Not IsMissing(flags) Then flags = OFN.flags
CommDlg = TrimNull(OFN.strFile)
Else
CommDlg = vbNullString
End If
End Function
'*************************************************************************
'**函 数 名：ahtAddFilterItem
'**输 入：strFilter(String) - 过滤字符串
'** ：strDescription(String) - 说明
'** ：Optional varItem(Variant) - 扩展名
'**输 出：(String) - 过滤字符串
'**功能描述：合成过滤字符串
'**全局变量：
'**调用模块：
'**作 者：
'**日 期：2003年04月11日
'**修 改 人：
'**日 期：
'**版 本：版本1.0
'*************************************************************************
Public Function ahtAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String
If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
End Function
'*************************************************************************
'**函 数 名：TrimNull
'**输 入：ByVal strItem(String) - 字符串(含chr(0))
'**输 出：(String) - 字符串chr(0)
'**功能描述：去除字符串结尾的
'**全局变量：
'**调用模块：
'**作 者：
'**修 改 人：
'**日 期：
'**版 本：版本1.0
'*************************************************************************
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function

[tfhappy]

Private Sub Command3_Click()

Dim a As MSComDlg.CommonDialog
Dim str_FilePath

Set a = Me.Controls.Add("MSComDlg.CommonDialog", "a")

a.ShowOpen

Label1.Caption = a.FileName


End Sub

记得在工程属性中取消 "删除有关未使用的 ActiveX 控件的信息

ActiveX 控件 是不能用new 和 CreateObject 建立实例的

[cdknet]

用tfhappy的方法

[li_chengpeng]

还是不行啊。。哎。。。

[cdknet]

我试过代码的，没有问题的，出了什么错误提示吗？
部件中要引用Microsoft Common Dialog Control 6.0

不引用就会出错！

[dingyanwei]

生成的程序要打包