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

 

[Senso]

@edmoor
Schakel in Verkenner onder > details koppelingsdoel een in dan kun je vergelijken met de inhoud van kolom E. Er zijn verschillen.

Het sluiten van het Excel-document gaat hier niet goed.

 

[edmoor]

Het werkt hier allemaal zonder enig probleem, kan ik niks anders van maken.
Maar ik gebruik ook geen Office versie van 18 jaar oud.

 

[Senso]

Ga ik dan in de nieuwe versie/nieuwe pc proberen.
Bedankt.

Achttien jaar later is blijkbaar niet alles beter...
In 2007 werden de shortcuts allemaal aangemaakt maar in 2021 Prof Plus niet één! Helemaal niets. Volgens mij wordt het bestand niet eens geopend.

 

[edmoor]

Ik heb ook Office 2021 en zoals ik al zei werkt het hier zonder enig probleem, ook de VBscript code.
En het is niet Office die de melding geeft, dat doet VBscript.

 

[edmoor]

Nog even naar je plaatje in #14 gekeken.
Waar komt de WshShortcut.Save vandaan?
Dat staat niet in de code van #10.

 

[Senso]

Dat weet ik niet. Feit is dat het ligt aan 'machtigingen'. Take ownership op de map gedaan en het werkt.
Ik heb van 8, 6 gemaakt admintools naar F, echter in de uitvoering wordt er = achter de opdrachtregel gezet. Wil jij daar nog eens naar kijken en afsluiten lukt nog steeds niet goed. Het document blijft met $ openstaan.

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

With oEXC.Activesheet
    While Inf <> "|"
    Rgl=Rgl + 1
    Inf = .Cells(Rgl, 1) & "|" & .Cells(Rgl, 5)
    If Inf <> "|" Then
        Arg = ""
        If .Cells(Rgl, 6) <> "" Then Arg = .Cells(Rgl, 6)
        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