UN AMIGO ME COMENTA QUE DESEA QUE SU PROGRAMA REGISTRE LAS OCX y/o DLL DE FORMA SILENCIOSA
Option Compare Database
Option Explicit
'PARA REGISTRAR ALGUNA OCX y/o DLL DE FORMA SILENCIOSA TE RECOMINDO LO SIGUIENTE
'1) Utiliza el MdlfrmOculto.... PARA LLAMAR AL FORMULARIO OCULTO Y EL ENCARGADO DE LA FUNCION
' DE REGISTRAR LAS OCX y/o DLL .....¿ por que ?
' PUES COMO VERAS AL MOMENTO DE ABRIR EL FORMULARIO INICIO Y ES ESTE EL QUE LLEVA EL CONTROL ACTIVEX
' NO PODEMOS REGISTRARLO DE FORMA TAN PROLIJA, COMO LO ESPERAMOS, DADO QUE AL CARGAR EL FORM INICIO
' TAMBIEN SE CARGA EL CONTROL ACTIVEX Y COMO NO ESTA REGISTRADO, TE SALTARIA UN ERROR o VARIOS
'2) EL FORMULARIO "frmOculto" ES EL ENCARGADO DE REGISTAR LA OCX y/o DLL
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Octubre - 2009 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
'Lo primero que haremos, sera crear las constantes que vamos a utilizar luego
'Establezco la constante direccion del sistema de windows (Para registrar nuestras ocx y/o dll)
Public Const Sistema As String = "C:\Windows\System\"
'Le creo estas constantes de los formularios que uso por si deseas copiar y pegar (Modificas solo esta parte)
Public Const frmInicio As String = "Inicio"
Public Const ElForm As String = "frmOculto"
'Ahora le ingresamos las OCX que el proyecto tenga a su haber
Public Const Ocx1 As String = "CommonDialogView.ocx"
Public Const Ocx2 As String = "ButtonXP.ocx"
Function JJJT_CopiaPegaRegistra(LaOcx As String)
'Establezco una linea de error
On Error GoTo Err_JJJT_Failed
'Utilizo la funcion JJJT_ExisteDir para comprobar que no exista la OCX y/o DLL en el sistema de windows
If JJJT_ExisteDir(Sistema & LaOcx) = False Then
'De no existir Copio la OCX y/o DLL al registro de Windows
FileCopy CurrentProject.Path & "\Las OCX - DLL\" & LaOcx, Sistema & LaOcx
'Uso la Funcion Shell REGSVR32 para registrar la OCX y/o DLL de forma silenciosa
Shell "REGSVR32 " & Sistema & LaOcx & " /s", vbHide
End If
Exit Function
Err_JJJT_Failed:
MsgBox "Error: " & Err.Number & " " & Err.Description
'Fin de la Funcion JJJT_CopiaPegaRegistra
End Function
Function JJJT_ExisteDir(ByVal Ruta As String) As Boolean
On Error Resume Next
JJJT_ExisteDir = (GetAttr(Ruta) And vbNormal) = vbNormal
Err.Clear
End Function