Office中国论坛/Access中国论坛

标题: 求控件自动注册实例! [打印本页]

作者: 真主 时间: 2005-9-17 23:31
标题: 求控件自动注册实例!
求控件自动注册实例!

如smartday的档案管理中的控件注册

[此贴子已经被作者于2005-9-17 15:36:15编辑过]

作者: wu8313 时间: 2005-9-18 00:43
试试这两段代码：1、Function AutoRegFile(FileName As String)

Dim reged As Boolean

Dim RegFile1 As String

Dim RegFile2 As String

Dim BeReg As String

Dim RetVal

BeReg = CurrentProject.Path & "\" & FileName

RegFile1 = Environ("windir") & "\system\regsvr32.exe "

RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

   If Dir(RegFile1) <> "" Then

         RegFile1 = RegFile1 & "/s" & " " & BeReg

         RetVal = Shell(RegFile1, 1)

      Else

         RegFile2 = RegFile2 & "/s" & " " & BeReg

         RetVal = Shell(RegFile2, 1)

      End If

Else

      MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

End If

End Function

使用方法：

把控件跟mdb文件放在同一个目录里,然后在程序中使用以下语句注册

AutoRegFile "控件名称"

-----------------------------------------------------------2、Function RegOCX(BeReg As String)

Dim RegFile1 As String

Dim RegFile2 As String

Dim RetVal

RegFile1 = Environ("windir") & "\system\regsvr32.exe "

RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

      If Dir(RegFile1) <> "" Then

         RegFile1 = RegFile1 & "/s" & BeReg

         RetVal = Shell(RegFile1, 1)

      Else

         RegFile2 = RegFile2 & "/s" & BeReg

         RetVal = Shell(RegFile2, 1)

      End If

Else

      MsgBox "找不到regsvr32.exe文件，无法完成自动注册，您需要手动注册" & BeReg & "这个控件", vbCritical, "无法自动注册控件"

End If

End Function

------------------------------------------------

作者: 真主 时间: 2005-9-18 03:05
试了,不成功!请指点

作者: smartday 时间: 2005-9-18 17:12
呵呵，我已经在用，可以的

作者: smartday 时间: 2005-9-18 17:15
下面是我用的代码：

Private Sub Form_Open(Cancel As Integer)

  '关闭自定义的工具栏

DoCmd.ShowToolbar "档案管理", acToolbarNo

DoCmd.ShowToolbar "档案管理报表工具", acToolbarNo

'检测后台数据库链接

Dim hdk As String

Dim cat As ADOX.Catalog

Dim tdf As ADOX.Table

If CheckLinks = False Then '如果连接错误

      hdk = CurrentProject.Path & "\date\档案管理_date.mdb"

      Set cat = New ADOX.Catalog

      Set cat.ActiveConnection = CurrentProject.Connection

      Set tdf = cat.Tables("user")

      tdf.Properties("jet oledb:link datasource") = hdk

End If

'窗体打开后自动注册控件

AutoRegFile "CALENDAR.OCX"

AutoRegFile "ctlstbar.ocx"

AutoRegFile "flash.ocx"

End Sub

Function AutoRegFile(FileName As String)

Dim reged As Boolean

Dim RegFile1 As String

Dim RegFile2 As String

Dim BeReg As String, strDtn As String, strDtn1 As String

Dim ref As Reference

Dim RetVal

BeReg = CurrentProject.Path & "\ocx\" & FileName       '控件存放位置，例子中是放在工程当前目录下ocx子目录

strDtn = Environ("windir") & "\system\" & FileName          '返回系统路径

strDtn1 = Environ("windir") & "\system32\" & FileName          '返回系统路径

On Error Resume Next

RegFile1 = Environ("windir") & "\system\regsvr32.exe "

RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

      If Dir(RegFile1) <> "" Then

         FileCopy BeReg, strDtn

         RegFile1 = RegFile1 & "/s" & " " & strDtn

         RetVal = Shell(RegFile1, 1)

         Set ref = References.AddFromFile(Environ("windir") & "\system\" & FileName)

      Else

         FileCopy BeReg, strDtn1

         RegFile2 = RegFile2 & "/s" & " " & strDtn1

         RetVal = Shell(RegFile2, 1)

         Set ref = References.AddFromFile(Environ("windir") & "\system32\" & FileName) '设置引用

      End If

Else

      MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

End If

End Function

[此贴子已经被作者于2005-9-18 9:24:34编辑过]

作者: 真主 时间: 2005-9-19 23:23
[attach]13189[/attach]

这样写,不行,请问什么地方写错

作者: smartday 时间: 2005-9-20 02:42
BeReg = CurrentProject.Path & "\ocx\" & FileName       '控件存放位置，例子中是放在工程当前目录下ocx子目录

strDtn = Environ("windir") & "\system\" & FileName          '返回系统路径

strDtn1 = Environ("windir") & "\system32\" & FileName          '返回系统路径

你这三个变量的赋值搞错了!

strdnt 和 strdtn1这两个变量是分别针对两种不同的情况来存放regsvr32.exe路径的,并不是用来注册OCX,看我给我例程!

[此贴子已经被作者于2005-9-19 18:44:15编辑过]

作者: 真主 时间: 2005-9-20 03:21
[attach]13195[/attach]

请帮我看看,谢谢

作者: wu8313 时间: 2005-9-20 05:17
代码改成这样，应该可以注册的了。

-------------------------------

Option Compare Database

Function AutoRegFile(FileName As String)

Dim reged As Boolean

Dim RegFile1 As String

Dim RegFile2 As String

Dim BeReg As String, strDtn As String, strDtn1 As String

Dim ref As Reference

Dim RetVal

BeReg = CurrentProject.Path & "\ocx\" & "Calendar.ocx"       '控件存放位置，例子中是放在工程当前目录下ocx子目录

strDtn = Environ("windir") & "\system\" & "Calendar.ocx"          '返回系统路径

strDtn1 = Environ("windir") & "\system32\" & "Calendar.ocx"          '返回系统路径

On Error Resume Next

RegFile1 = Environ("windir") & "\system\regsvr32.exe "

RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

      If Dir(RegFile1) <> "" Then

         FileCopy BeReg, strDtn

         RegFile1 = RegFile1 & "/s" & " " & strDtn

         RetVal = Shell(RegFile1, 1)

         Set ref = References.AddFromFile(Environ("windir") & "\system\" & Calendar.ocx)

      '设置一个对话框来提醒一下注册是否成功

         MsgBox "注册成功"



      Else

         FileCopy BeReg, strDtn1

         RegFile2 = RegFile2 & "/s" & " " & strDtn1

         RetVal = Shell(RegFile2, 1)

         Set ref = References.AddFromFile(Environ("windir") & "\system32\" & Calendar.ocx) '设置引用



         MsgBox "注册成功"



      End If

Else

      MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

End If

End Function

-------------------

'用来调用上面的过程

在立即窗口中输入 call regmyocx()  看看会得到怎样的结果。

Sub regmyocx()

AutoRegFile "calendar.ocx"

End Sub

-----------------

解释一下你的原来代码存在的问题：

在上述代码的蓝色部分，你没有使用 "" 来连接，调用的时候，出现“编译错误：无效的界定符”提示  ，所以认为你的代码出现语法错误而导致编译错误的。后来，看到蓝色部分有问题了。

------------------------------

蓝色部分的后两句代码，是用来获得系统文件夹路径的

针对 win98/winme/winxp 的系统文件夹是 system

针对 winnt /2k  的系统文件夹是 system32

不同的操作系统 regsvr32.exe(操作系统自带的)  这个文件的位置是不同的，是system 或者 system32 两者之一。

----------------------------------------------

[此贴子已经被作者于2005-9-20 21:05:04编辑过]

作者: smartday 时间: 2005-9-20 06:55
呵呵,讲得够明白的了,应该会用了吧

作者: 真主 时间: 2005-9-20 16:08
谢谢,请问程序是不是已经自动把控件COPY到系统目录中了,我看好像是这样

作者: smartday 时间: 2005-9-20 20:28
是的，是这样的，如果你是用winrar打包的话，可以把原来的\ocx下的东西删了

作者: wu8313 时间: 2005-9-21 05:07
搜到了这个日历控件，做了一个例子，楼主看看是否可以使用起来。[attach]13221[/attach]

[此贴子已经被作者于2005-9-20 21:07:11编辑过]

作者: cg1 时间: 2005-10-3 22:06
关于此主题请参考：

《VBA》如何激活/运行存储在窗体ole容器中的对象？

http://access911.net/index.asp?u1=a&u2=78FAB01E

直接在里面放一个 REG 文件即可

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)