Run Module from Macro or...

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
 
A

Arvin Meyer [MVP]

You probably only want to execute it once, or replace it only if missing.
When the form loads, (On Load event) simply call your sub:

Sub Form Load()
If Len(Dir("C:\Full Path to shortcut")) = 0 Then
CrearAccesoDirecto
End If
End Sub
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads:
http://www.datastrat.com
http://www.mvps.org/access

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
 
A

Arvin Meyer [MVP]

The path on my XP machine to a shortcut might be:

"C:\Documents and Settings\Arvin\Desktop\Whatever.lnk"

Many desktop paths are the same, but if you need a different path, you'll
have to supply one for your specific OS
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads:
http://www.datastrat.com
http://www.mvps.org/access

Hello Arvin, thanks for reply.

I dont understand the "C:\Full Path to shortcut" line..... What's happen if
the Operative System is win 98/Me NT/2000/xp ??

I put your code in my application and not working, though runing the module
independently yes....

Help me!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Thanks a lot!

Utopian.-
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top