|
可加载一个空窗体如下,注册控件,再启动窗体2打开实际功能。另外也将控件打包成安装包。
Private Sub Form_Open(Cancel As Integer)
DoCmd.RunCommand acCmdAppMinimize
Me.Visible = False
AutoRegFile "控件名"
DoCmd.Close
DoCmd.OpenForm "窗体2"
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 |
|