Actualizar BD (Front-End) Desde una Ubicacion en Internet
Recursivamente estamos mejorando nuestra BD Front-End para darle mas opciones a nuestros usuarios y haciendola mas util en el entorno de trabajo.
Se ha planteado guindar en nuestras "paginas, sites, blogs o cualquier enlance a internet que nos pertenezca", las actualizaciones que estas vallan sufriendo
Idea que he tomado de un Forero de Access "A_Selfa" => Agustin, quien planteo esta opcion.
Para esto solo he recurrido a las API de windows URLDownloadToFile, InternetCheckConnection, ShellExecute.
El Codigo que utilizo
Option Compare Database
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Junio - 2010 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
'Usando solamente API
Option Explicit
'Funcion API Ejecutar Archivo
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
'Funcion API URLDownloadToFile
Public Declare Function DescargaInternet _
Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
Optional ByVal pCaller As Long, _
Optional ByVal szURL As String, _
Optional ByVal szFileName As String, _
Optional ByVal dwReserved As Long, _
Optional ByVal lpfnCB As Long) As Boolean
'Funcion API Conexion a Internet
Public Declare Function HayConexion Lib _
"wininet.dll" Alias _
"InternetCheckConnectionA" ( _
ByVal lpszUrl As String, _
ByVal dwFlags As Long, _
ByVal dwReserved As Long) As Boolean
Public RutaInternet As String
Public RutaZip As String
Public MiVersion As String
Public ArchivoInternet As String
Public ExtArchInternet As String
Public UrL As String
Sub MisDatos()
'Le Cargo a las variables mis datos
RutaInternet = "http://-s-sites.googlegroups.com/site/jjjt1973/Home/agenda-de-cumpleanos/"
MiVersion = Right(Application.VBE.ActiveVBProject.Name, _
Len(Application.VBE.ActiveVBProject.Name) - _
InStrRev(Application.VBE.ActiveVBProject.Name, "_"))
ArchivoInternet = "ActualizaSoft_" & MiVersion + 1
ExtArchInternet = ""
UrL = RutaInternet & ArchivoInternet & ExtArchInternet
RutaZip = "\ActualizaSoft_" & MiVersion + 1 & ExtArchInternet
End Sub
Function JJJT_ExisteDir(ByVal Ruta As String) As Boolean
On Error Resume Next
JJJT_ExisteDir = (GetAttr(Ruta) And vbNormal) = vbNormal
Err.Clear
End Function
Sub Actualiza_Soft_Descarga()
MisDatos 'Llamo a Cargar Datos
If JJJT_ExisteDir(CurrentProject.Path & RutaZip & ".exe") = False Then
'Si la actualizacion existe en el Path , no dejo correr la BD
If HayConexion("http://www.google.com.ve/", 0&, 0&) = False Then
'Por aqui veo si tengo conexion a internet y dejo correr la funcion
If DescargaInternet(0, UrL, CurrentProject.Path & RutaZip, 0, 0) = False Then
'Primero descargo de Internet la Acualizacion y lanzo la pregunta
If MsgBox("Este proceso actualiza esta BD (Front) " & vbCrLf & _
"Desde una ubicacion en internet" & vbCrLf & vbCrLf & _
"Este evento lo pudieses lanzar desde un formulario" & vbCrLf & _
"Que habra estilo notificacion messenger, desde" & vbCrLf & _
"un tooltips balloons, notificando en el SysTrays" & vbCrLf & vbCrLf & _
"Seguro desea continuar...?", vbInformation _
+ vbYesNo, NombreBD) = vbYes Then
MsgBox "La actualizacion se ha descargado correctamente" & vbCrLf & _
"Y se va a ejcutar de inmediato", vbInformation, NombreBD
'Como en mi pagina no puedo subir extensiones .EXE, se la elimino y despues
'al descargar renombro la aplicacion y vuelvo a colocarsela
Name CurrentProject.Path & RutaZip As CurrentProject.Path & RutaZip & ".exe"
Call ShellExecute(0&, "open", CurrentProject.Path & RutaZip & ".exe", 0&, vbNullString, 1&)
'Ejecuto la Actualizacion con CreateInstall
DoCmd.Quit
'Pero primero cierro
Else
'Si elegiste no actualizar, elimino la descarga
Kill (CurrentProject.Path & RutaZip)
'Y detengo el codigo
Exit Sub
End If
Else
' No hay Actualizaciones
End If
Else
'No Hay Internet
Exit Sub
End If
Else
MsgBox "Es necesario Actualizar...." & vbCrLf & vbCrLf & _
"por lo tanto, esta BD (Front) no podra ejecutarse" & vbCrLf & _
"hasta tanto no se lleve a cabo este proceso", vbInformation, NombreBD
Call ShellExecute(0&, "open", CurrentProject.Path & RutaZip & ".exe", 0&, vbNullString, 1&)
DoCmd.Quit
Exit Sub
End If
End Sub
Y para llamar la funcion, se haria desde cualquier evento que elijamos.....
Call Actualiza_Soft_Descarga
En el ejemplo utilizo CreateInstall y Forzo la Ruta C:\Archivos de programa\Gastos
Para no perder la vinculacion a la Back-End
Ademas es este Instalador (CreateInstall) al que le ordeno sobreescribir el Front-End si se va a Actualizar