Uno ejemplos mas abajo comento sobre como actualizar una BD por otra mas nueva, descargando la BD_Nueva desde una ubicacion en Internet (Por su puesto esta pagina o site debe pertenecernos) ....
el Ejemplo es este
63) Actualizar BD (Front-End) Desde una Ubicacion en Internet
Ahora bien, podemos informacion a nuestros usuarios, mediante una notificacion al estilo Messenger
65) Notifica al Estilo Messenger Splash
O Notificando al SysTray (Barra de Heramientas de Windows) de tal evento
** EL CODIGO **
Option Compare Database
Option Explicit
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Junio - 2010 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
'Declaramos las APIs a utilizar
'Para Extraer el icono de la Carpeta
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" _
(ByVal hInst As Long, _
ByVal lpIconPath As String, _
lpiIcon As Long) As Long
'Para cargar el Icono al SysTray
Private Declare Function LoadImage Lib "USER32" Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal iImageType As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal fFlags As Long) As Long
'Para destruir el Icono del SysTray
Private Declare Function DestroyIcon Lib "USER32" (ByVal hIcon As Long) As Long
'Para Notificar al SysTray
Private Declare Function ShellNotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long
'Para encontrar el TwipsPerPixelX
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
'Para extraer el nombre de la BD activa
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" _
(ByVal lpszFile As String, _
ByVal lpszTitle As String, _
ByVal cbBuf As Integer) As Integer
'La Estructura del SysTray al Notificar
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 128
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
'Las Constantes de la API ShellNotifyIcon
Public Const WM_LBUTTONDBLCLK = &H203
Const NIF_INFO = &H10
Const NIIF_INFO = &H1
Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
Const WM_MBUTTONDBLCLK = &H209
Private SysTray As NOTIFYICONDATA
Private IcoNhWnd As Long
Sub NotificaSysTray( _
frm As Form, _
Optional TipText As String, _
Optional BalloonTipTex As String, _
Optional RutaIcon As String)
'Busco el Twips del form
TwipsPerPixelX frm
'Busco el long del Icono
IcoNhWnd = LoadImage(0&, RutaIcon, 1, 16&, 16&, &H10)
'Si el Icono no existe
If IcoNhWnd = 0 Then
'Le cargo el de la carpeta Activa
IcoNhWnd = ExtractAssociatedIcon(Application.hWndAccessApp, "", 0)
End If
With SysTray
'Tamaño de la estructura al Systray
.cbSize = Len(SysTray)
'El hwnd del form activo
.hWnd = frm.hWnd
'El handle de la barra de tareas
.uID = vbNull
'Los flags para la estructura
.uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
'Estableze el mensaje a windows
.uCallbackMessage = WM_MOUSEMOVE
'Dibuja el Icono seleccionado a la barra de tareas
.hIcon = IcoNhWnd
'Le paso el Texto al tooltips
.szTip = TipText & Chr(0)
'El estado de la barra para los Balloon Tips
.dwState = vbNull
'La mascara de la barra para los Balloon Tips
.dwStateMask = vbNull
'El Texto del Balloon Tips
.szInfo = BalloonTipTex & Chr(0)
'El titulo del Balloon Tips
.szInfoTitle = MiBd & Chr(0)
'Definitivamente la Forma Balloon Tips
.dwInfoFlags = NIIF_INFO
'Tiempo de duracion al pasar el mouse
.uTimeout = 100
End With
'Funcion al llamado API Notificando al Systray
Call ShellNotifyIcon(NIM_ADD, SysTray)
End Sub
Sub QuitaSysTray(frm As Form)
'Elimino la Notificacion al Systray
Call ShellNotifyIcon(NIM_DELETE, SysTray)
'Destruyo el icono
Call DestroyIcon(IcoNhWnd)
End Sub
Function MiBd() As String
'Establezco el tipo y los caracteres; Ejecuto la API
MiBd = String(255, 0): GetFileTitle CurrentDb.Name, MiBd, Len(MiBd)
'Estraigo el nombre y se lo paso a la funcion
MiBd = Left$(MiBd, InStr(1, MiBd, Chr$(0)) - 1)
End Function
Function TwipsPerPixelX(frm As Form) As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long
lngDC = GetDC(frm.hWnd)
TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, 88)
ReleaseDC frm.hWnd, lngDC
End Function