VBA snelkoppeling

Status
Niet open voor verdere reacties.
P

pvag

Gebruiker
Lid geworden
7 jan 2009
Berichten
60
Hallo,

Met onderstaande script maak ik vanuit een database de nodige mappen aan op D:
In één van de mappen (D:\Mijn_werkmap\Inspiratiestudio\Sjablonen\Excel) wordt het sjabloon van de factuursheet (Factureren_Inspiratiestudio.xltm) opgeslagen zodra onderstaande code wordt uitgevoerd.
Nu zou ik graag willen dat er met een aanvullend script EENMALIG een snelkoppeling van het bestand ( Factureren_Inspiratiestudio.xltm ) wordt gemaakt naar mijn bureaublad.
Het mooist zou zijn dat ik uit de database het path zou kunnen aangeven waar het sjabloon is opopgeslagen.
Ik ben absoluut geen expert en probeer te begrijpen wat er in een dergelijk script gebeurd, en blijf net zo langproberen tot het werkt. Nu kom ik even niet verder.
Wie kan mij verder helpen. Bij voorbaat dank, Groet, Ton

Code: 
Private Sub cmdInstalOpslaan_Click()

'Zorg dat in VBA Menu\Extra\Verwijzing de optie "Microsoft Shell Controls And automation" is aangevinkt.
  Dim objShell As Shell32.Shell
  Dim sDir  As String
  Dim sSubDirAmdin As String
  Dim sSubDirSjab As String
  Dim sSubDirFact As String
  Sheets("Instalgegevens").Select
    
  Set objShell = New Shell32.Shell
  With Sheets("Instalgegevens")
                           
  objShell.Namespace(.Range("L4") & ":").NewFolder .Range("M4") & "" & .Range("N4") & "" & .Range("O4")                                   ' Het path naar Administratie
  objShell.Namespace(.Range("L4") & ":").NewFolder .Range("M4") & "" & .Range("N4") & "" & .Range("O4") & "" & .Range("S4")     ' Het path naar Facturen uitgaand
  ' hieronder wordt het path gemaakt D:\Mijn_werkmap\Inspiratiestudio\Sjablonen\Excel          waarin het sjabloon is opgeslagen.
 '                                           D:             Mijn_werkmap      Inspiratiestudio    Sjablonen                        Excel       Factureren_Inspiratiestudio.xltm
 objShell.Namespace(.Range("L4") & ":").NewFolder .Range("M4") & "" & .Range("N4") & "" & .Range("P4") & "" & .Range("Q4")     ' Het path naar het Excelsjablonen
  objShell.Namespace(.Range("L4") & ":").NewFolder .Range("M4") & "" & .Range("N4") & "" & .Range("P4") & "" & .Range("R4")      'Het path naar Wordsjablonen
  
 
  'Dim wSheet As Worksheet
  'Dim wSheet = ("Instalgegevens").Activate
  Set wSheet = ActiveSheet
  
  
 MsgBox "De installatie heeft plaats gevonden op schijf: " & wSheet.Range("L4") & _
  vbCrLf & vbCrLf & "De volgende mappen en submappen zijn aangemaakt. " & _
  vbCrLf & vbCrLf & wSheet.Range("L4") & ":" & wSheet.Range("M4") & "" & wSheet.Range("N4") & "" & wSheet.Range("O4") _
  & vbCrLf & wSheet.Range("L4") & ":" & wSheet.Range("M4") & "" & wSheet.Range("N4") & "" & wSheet.Range("O4") & "" & wSheet.Range("S4") _
  & vbCrLf & wSheet.Range("L4") & ":" & wSheet.Range("M4") & "" & wSheet.Range("N4") & "" & wSheet.Range("P4") & "" & wSheet.Range("Q4") _
  & vbCrLf & wSheet.Range("L4") & ":" & wSheet.Range("M4") & "" & wSheet.Range("N4") & "" & wSheet.Range("P4") & "" & wSheet.Range("R4") _
  .Value, vbOKOnly + vbInformation, "Installatieoverzicht mappen en submappen"

  End With
  Set objShell = Nothing
  
End Sub
 
Laatst bewerkt door een moderator:
Dit is wat ik zelf gebruik voor het maken van een snelkoppeling. Dat kan je vast aanpassen voor je eigen situatie:
Code: 
Sub sXL_CreateShortCut()
    Dim oWSH As Object
    Dim oShortcut As Object
    Dim sPathDesktop As String
    Dim sShortcut As String
    
    Set oWSH = CreateObject("WScript.Shell")

    sPathDesktop = oWSH.SpecialFolders("Desktop")
    sShortcut = sPathDesktop & "\Shortcut - " & ActiveWorkbook.Name & ".lnk"
    Set oShortcut = oWSH.CREATESHORTCUT(sShortcut)
       
    With oShortcut
        .TargetPath = ActiveWorkbook.FullName
        .Save
    End With
    Set oWSH = Nothing
End Sub
 
Laatst bewerkt:
Hoi Edmoor,

bedankt voor je effectieve hulp. Het werkt perfect. Mijn dank hiervoor.
M.v.g. Ton
 
Beste pvag,

Ik heb je code even tussen codehaakjes gezet.

Mooi dat de oplossing al werkt!

m.v.g
Rick van Lieshout
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan