检测控件是否注册，并可自动注册

apsfxc1

这个不错，要支持

wanshan

规范和改进了代码，一楼附件已更新！

Public Function chkCtr(Class As String) As Boolean    '检测控件是否注册

    On Error Resume Next
   
    Dim tmpObj As Object
    Set tmpObj = CreateObject(Class)

    If tmpObj Is Nothing Then
        chkCtr = False
    Else
        chkCtr = True
    End If

End Function

Public Function ctrReg(ctrName As String, Optional regState As Boolean = False, Optional allowMsg As Boolean = False) As String '注册/反注册控件

    '获取系统目录
    Dim sysDir As String
    sysDir = Environ("windir") & "\system32\" & ctrName
   
    If regState Then      '如果已注册
        Shell "Regsvr32.exe   " + sysDir + " /u /s"
        MsgBox "控件：" & ctrName & "反注册成功！", vbOKOnly + vbInformation, Title
    Else
        If Dir(sysDir, vbDirectory) = "" Then      '判断系统目录下是否有控件文件
            Set FS = CreateObject("Scripting.FileSystemObject")
            FS.copyfile CurrentProject.Path & "\" & ctrName, sysDir
        End If
        Shell "Regsvr32.exe   " + sysDir + " /s"
        If allowMsg Then MsgBox "控件：" & ctrName & "注册成功，需重启才能生效！", vbOKOnly + vbInformation, Title
    End If

End Function

'自动检测并注册控件代码：
If chkCtr("BARCODEX.BarcodeXCtrl.1") = False Then Call ctrReg("barcodex.ocx")

'手动注册/反注册控件代码：
        If MsgBox("请问您确定要" & IIf(Me.控件列表.Column(1), "反", "") & "注册控件" & Me.控件列表.Column(3) & "吗？", vbYesNo + vbQuestion, Title) = vbYes Then
            Call ctrReg(Me.控件列表.Column(3), Me.控件列表.Column(1), True)
            Me.控件列表.Requery
        End If

67613188

沙发

wuheng

谢谢，学习了~~~~~~~~~~~``

goto2008

谢谢分享

khmkhm

谢谢分享