Option Compare Database
Option Explicit
Function MiraReferenciasVBA()
Dim Ref As Reference
'Bhúo, Junio de 2002
'Puede servir para cuando distribuyamos una aplicacion
'con referencias externas a funciones inmersas en: OCX,DLL, MDE, MDB...)
'que nosotros en el proyecto hemos referenciado desde una determinada ubicación
'local de nuestro PC y a la hora de ejecutar el programa el usuario, pueda dar errores
'por no tener dichas referencias o tenerlas en otra ubicacion distinta
'y de esta forma el usuario nos pueda avisar de esta contingencia.
'Esta función se puede poner en el formulario de inicio de la aplicación
'para avisar al usuario de este tema.
For Each Ref In References
If Ref.IsBroken = False Then
' este msgbox e puramente informativo de las referencias que están OK
' y es para probar este código.
Msgbox "Nombre de la Referencia: " & Ref.Name & vbCrLf _
& "En la ruta: " & Ref.FullPath & vbCrLf _
& "Versión de la Referencia: " & Ref.Major & "." & Ref.Minor, vbInformation + vbOKOnly, "Referencias en VBA"
Else
' referencia rota
Msgbox "Nombre de la Referencia rota:" & Ref.Name & vbCrLf _
& "Ruta Origina: " & Ref.FullPath & vbCrLf _
& "GUID completo de la Referencia: " & Ref.Guid, vbCritical + vbOKOnly, "AVISO: Servicio de mantenimiento del programa 95-22222222."
'aquí la acción a seguir...
'En este ejemplo, se podría poner ruta completa, mediante
'un dialogo de Windows e intentar referenciar de nuevo
'la referencia rota o bien abandonar la aplicacion.
'En este caso ponemos una ruta fija que sirva de ejemplo:
'C:\Windows\System\Mscal.ocx
'Recordar que el nombre y Path original de la referencia
'sería ref.FullPath
'============Dos opciones, o eliminar la referencia que falta:
References.Remove Ref
'=====================
' o Intentar regenerarla:
If CrearNuevaReferencia("C:\Windows\System\Mscal.ocx") = False Then
Msgbox "No se ha podido regenerar la referencia.", vbCritical + vbOKOnly, "Aviso"
Else
Msgbox "La Referencia, " & Ref.FullPath & " se ha establecido correctamente.", vbExclamation + vbOKOnly, "Correcto"
End If
End If
Next Ref
End Function
Function CrearNuevaReferencia(PathCompletoFichero As String) As Boolean
Dim Ref As Reference
On Error GoTo Error_CrearNuevaReferencia
Set Ref = References.AddFromFile(PathCompletoFichero)
CrearNuevaReferencia = True
Exit_CrearNuevaReferencia:
Exit Function
Error_CrearNuevaReferencia:
Msgbox "Aviso Nº: " & Err & "..." & Err.Description & " [" & PathCompletoFichero & "]", vbCritical + vbOKOnly, "Aviso de Error"
CrearNuevaReferencia = False
Resume Exit_CrearNuevaReferencia
End Function
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)