Newsgroup: it.comp.appl.access
Titolo: Creazione link completo con utilizzo di file mdw (Pubblicazione)

Ciao a tutti, tempo fa era passato un post su come creare un link ad access 
non conoscendo la versione e utilizzando per l'apertura un file mdw.
Ebbene non so se qualcuno ha già risolto il problema ma qui di seguito 
troverete il codice per la creazione di un link completo....se poi vorrà 
essere pubblicato su 
www.sitocomune.com
 non mi farà solo che piacere... :-)) 
(....MA mettici una buona parola! :-))....)
Il codice è stato sperimentato con AC2000 - AC2003 e WXP - W2K ma con debite 
modifiche potrebbe funzionare anche con altre versioni di SO e AC
Spero vi possa essere utile!
Ciao a tutti
Roberto da Parma
--------------------------------------------------------------------------------------------------------------------------------------
Function CreaLink()
'Creata da Arisi Roberto (su ICAA Roberto da Parma)
    Dim WshShell, strDesktop, oShellLink, oUrlLink
    Dim percorso As String
    percorso = Environ("userprofile") & "\Desktop\" 'Ricava il percorso del 
desktop
    If Dir(percorso & GetNamePartEx(Left(CurrentDb.Name, 
Len(CurrentDb.Name) - 3)) & "lnk") = GetNamePartEx(Left(CurrentDb.Name, 
Len(CurrentDb.Name) - 3)) & "lnk" Then 'Controlla se esiste un'altro link 
con lo stesso nome e lo cancella....decidete voi poi se utilizzarlo o meno
        Kill percorso & GetNamePartEx(Left(CurrentDb.Name, 
Len(CurrentDb.Name) - 3)) & "lnk"
    End If
    Set WshShell = CreateObject("WScript.Shell")
    strDesktop = WshShell.SpecialFolders("Desktop")
    Set oShellLink = WshShell.createshortcut(strDesktop & "\" & 
GetNamePartEx(Left(CurrentDb.Name, Len(CurrentDb.Name) - 3)) & "lnk") 
'Ricava il nome del database per dare il nome al link
    'Le opzioni di avvio non possono essere inserite qui...ecco il motivo 
della riga successiva...
    oShellLink.TargetPath = Chr(34) & SysCmd(acSysCmdAccessDir) & 
"MSACCESS.EXE" & Chr(34) 'Ricava il percorso di MSACCESS.EXE
    'Questo comando non è menzionato nella guida ed è stata 
un'improvvisazione, setta appunto le opzioni di avvio...funziona!
    oShellLink.Arguments = " /wrkgrp " & Chr(34) & 
Application.CurrentProject.Path & "\System.mdw" & Chr(34) & " " & Chr(34) & 
CurrentDb.Name & Chr(34)
    oShellLink.WindowStyle = 1
    'oShellLink.Hotkey = Ctrl+Alt+e 'facoltativa...setta hotkey
    oShellLink.IconLocation = Application.CurrentProject.Path & "\Icona.ico" 
'Recupera l'icona dal percorso d'installazione del DB
    oShellLink.Description = "Gestione " & 
Left(GetNamePartEx(CurrentDb.Name), Len(GetNamePartEx(CurrentDb.Name)) - 4) 
'Descrizione del link
    oShellLink.WorkingDirectory = Application.CurrentProject.Path
    oShellLink.Save
    Set WshShell = Nothing
    Set strDesktop = Nothing
    Set oShellLink = Nothing
End Function
Public Function GetNamePartEx(strPath As String) As String
'*****************************************************************
'Name      : GetNamePart (Function)
'Purpose   : Restituisce solo il nome
'Author    : Arisi Roberto
'Date      : 23 settembre 2006
'Inputs    : strPath="C:\DataBase.mdb"
'Output    : GetPathPart="Database.mdb"
'*****************************************************************
    Dim intCounter As Integer
    For intCounter = Len(strPath) To 1 Step -1
      If Mid$(strPath, intCounter, 1) = "\" Then
        Exit For
      End If
    Next intCounter
    GetNamePartEx = Right$(strPath, Len(strPath) - intCounter)
End Function 

 debite modifiche potrebbe funzionare anche con altre versioni di SO e AC
Robè, mo lo provo, e se va, te lo pubblico, ok? ;-)


 ha scritto nel messaggio 
news:x4hdi.41062$%k.16...@twister2.libero.it...

Porcaccia....sorry....ho sbagliato i collegamenti!!!
Naturalmente se venisse pubblicato anche su 
www.accessgroup.it
 non mi 
dispiacerebbe.... :-)))
Speriamo allora che funzi....se no sai che figura!
Grazie
Roberto da Parma