U
Utopian
Hello everbody.
I have a module (to create a Desktop ShortCut) that I expose below, and I need that it is executed when the Initial Form of my application loads
I hope can help me, Thanks
--------------------------------------------------------------------------------
'*********************************************************
'
' CrearAccesoDirecto
'
' Rutina que crea un acceso directo en el escritorio de la
' base de datos actual. Si la bd tiene asociado un icono
' se utilizará para el acceso directo, y si no, se le
' pondrá el predeterminado para BDs de Access
'
' Autor: Juan M. Afán de Ribera
' Fecha: Junio 2003
'
Sub CrearAccesoDirecto()
Dim WScript As Object 'New WshShell
Dim AccesoDirecto As Object 'WshShortCut
Dim Escritorio As String
Set WScript = CreateObject("WScript.Shell")
'obtenemos la ruta del escritorio
Escritorio = WScript.SpecialFolders("Desktop")
'creamos el acceso directo a nuestra bd
Set AccesoDirecto = WScript.CreateShortcut _
(Escritorio & "\" & Dir(CurrentDb.Name) & ".lnk")
'decimos donde está la bd
AccesoDirecto.TargetPath = CurrentDb.Name
On Error GoTo err_IconoAccesoDirecto
AccesoDirecto.IconLocation = _
CurrentDb.Properties("AppIcon")
'indicamos el directorio de trabajo
'usuarios de Access 97 han de utilizar esta línea
'AccesoDirecto.WorkingDirectory = CurrentProjectPath
'usuarios de Access 2000 o superior han de utilizar
'esta línea
'AccesoDirecto.WorkingDirectory = CurrentProject.Path
'y grabamos el trabajo
AccesoDirecto.Save
exit_CrearAccesoDirecto:
Set AccesoDirecto = Nothing
Set WScript = Nothing
Exit Sub
err_IconoAccesoDirecto:
If Err.Number = 3270 Then 'no existe la propiedad
'asignamos el icono predeterminado para
'bases de datos de Access
AccesoDirecto.IconLocation = SysCmd( _
acSysCmdAccessDir) & "\msaccess.exe, 1"
Resume Next
Else
MsgBox Err.Description
GoTo exit_CrearAccesoDirecto
End If
End Sub
I have a module (to create a Desktop ShortCut) that I expose below, and I need that it is executed when the Initial Form of my application loads
I hope can help me, Thanks
--------------------------------------------------------------------------------
'*********************************************************
'
' CrearAccesoDirecto
'
' Rutina que crea un acceso directo en el escritorio de la
' base de datos actual. Si la bd tiene asociado un icono
' se utilizará para el acceso directo, y si no, se le
' pondrá el predeterminado para BDs de Access
'
' Autor: Juan M. Afán de Ribera
' Fecha: Junio 2003
'
Sub CrearAccesoDirecto()
Dim WScript As Object 'New WshShell
Dim AccesoDirecto As Object 'WshShortCut
Dim Escritorio As String
Set WScript = CreateObject("WScript.Shell")
'obtenemos la ruta del escritorio
Escritorio = WScript.SpecialFolders("Desktop")
'creamos el acceso directo a nuestra bd
Set AccesoDirecto = WScript.CreateShortcut _
(Escritorio & "\" & Dir(CurrentDb.Name) & ".lnk")
'decimos donde está la bd
AccesoDirecto.TargetPath = CurrentDb.Name
On Error GoTo err_IconoAccesoDirecto
AccesoDirecto.IconLocation = _
CurrentDb.Properties("AppIcon")
'indicamos el directorio de trabajo
'usuarios de Access 97 han de utilizar esta línea
'AccesoDirecto.WorkingDirectory = CurrentProjectPath
'usuarios de Access 2000 o superior han de utilizar
'esta línea
'AccesoDirecto.WorkingDirectory = CurrentProject.Path
'y grabamos el trabajo
AccesoDirecto.Save
exit_CrearAccesoDirecto:
Set AccesoDirecto = Nothing
Set WScript = Nothing
Exit Sub
err_IconoAccesoDirecto:
If Err.Number = 3270 Then 'no existe la propiedad
'asignamos el icono predeterminado para
'bases de datos de Access
AccesoDirecto.IconLocation = SysCmd( _
acSysCmdAccessDir) & "\msaccess.exe, 1"
Resume Next
Else
MsgBox Err.Description
GoTo exit_CrearAccesoDirecto
End If
End Sub