Maak Windows snelkoppelingen met VBA

[Senso]

Wie kan/wil de VBA-code aanpassen en een knop maken > Maak snelkoppelingen
In kolom A staat de bestandsnaam en kolom E het doel.

 

[jverkerk]

Zoiets, gemaakt via Chatgpt.
Zelf geen verstand van VBA.

 

[edmoor]

Ik denk dat TS Windows snelkoppelingen (.lnk) bedoelt.

 

[Senso]

Met dank. Is leuk bedacht. Ik wilde graag de snelkoppelingen gemaakt in Windows Verkenner map > E:\test\

 

[edmoor]

Vanuit Excel zelf kan dat lastige beveiligings meldingen opleveren.
Zet dit in een bestandje met de naam MaakLNK.vbs:

Set Shell = CreateObject("WScript.Shell")
Set oEXC = CreateObject("Excel.Application")
oEXC.Workbooks.Open "Maak Windows Snelkoppelingen.xlsm"

With oEXC.Activesheet
    While Inf <> "|"
        Rgl=Rgl + 1
        Inf = .Cells(Rgl, 1) & "|" & .Cells(Rgl, 5)
        If Inf <> "|" Then lnk .Cells(Rgl, 1), .Cells(Rgl, 5)
    Wend
End With

Sub Lnk (Oms, Exe)
    Set link = Shell.CreateShortcut("E:\test\" & Oms & ".lnk")
    link.Description = Oms
    link.TargetPath = Exe
    link.WindowStyle = 1
    link.Save
End Sub

Zet dat bestandje in dezelfde map als het Excel bestand en dubbelklik er dan op.

 

[jverkerk]

Deze dan?

 

[Senso]

Die van Johan werkt de eerste niet goed omdat denk ik er een spatie in zit.

C:\Windows\System32\control.exe admintools

Van Edmoor blijft > Kan het bestand niet vinden Regel 3 Teken 1 Controleer spelling naam en locatie. Deze zijn wel goed. 800A03EC MS Office Excel.

oEXC.Workbooks.Open "Maak Windows Snelkoppelingen.xlsm"
Ik zie geen verschil met de bestandsnaam.

 

[edmoor]

Bij mij staan zowel het Excel bestand als het .vbs bestandje op de desktop en werkt het zonder enig probleem.
Geef anders het juiste pad van het Excel bestand in de code op.

 

[Senso]

Ik heb ze beide op het bureaublad gezet en zelfde error.
Gaat het dan weer om de Excel-versie? H&S 2007?

Nu in de map E:\test\ gezet en werkt.
De spatie is blijkbaar in de eerste link een probleem. Laat je admintools weg gaat het wel goed. Het lijkt aan het koppelingsdoel goed te zijn maar opent dan niet. Dat is wel in dit geval de enigste.

Het script zou de Excel-file aan het eind moeten sluiten. Het blijft nu openstaan en reageert niet goed.

 

[edmoor]

Voor de Admintools geef je dus een argument mee.
Maak er dan dit van en zet in cel H8 het woord Admintools en haal die weg uit cel E1.
Dit sluit ook de Excel sessie:

Set Shell = CreateObject("WScript.Shell")
Set oEXC = CreateObject("Excel.Application")
oEXC.Workbooks.Open "E:\test\Maak Windows Snelkoppelingen.xlsx"

With oEXC.Activesheet
    While Inf <> "|"
    Rgl=Rgl + 1
    Inf = .Cells(Rgl, 1) & "|" & .Cells(Rgl, 5)
    If Inf <> "|" Then
        Arg = ""
        If .Cells(Rgl, 8) <> "" Then Arg = .Cells(Rgl, 8)
        lnk .Cells(Rgl, 1), .Cells(Rgl, 5)
    End If
    Wend
End With
oEXC.Application.Quit

Sub Lnk (Oms, Exe)
    Set link = Shell.CreateShortcut("E:\test\" & Oms & ".lnk")
    link.Description = Oms
    link.TargetPath = Exe
    if Arg <> "" then link.Arguments = Arg
    link.WindowStyle = 1
    link.Save
End Sub

 

[snb]

wijzig G:\OF\adressen,xlsx door een volledig pad naar een bestaand bestand

Sub M_maak_snelkoppeling()
    With CreateObject("WScript.Shell")
        With .CreateShortcut(.SpecialFolders(4) & "\senso.lnk")
            .TargetPath = "G:\OF\adressen.xlsx"
            .Save
        End With
    End With
End Sub