Opgelost 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 ~$Maak Windows Snelkoppelingen openstaan. Klik ik er op dan gaat het over Alleen lezen. Sluiten dan opnieuw opslaan andere naam. Verwijderen kan niet want document staat open. Onder Taakbeheer niet te vinden etc. Dat kost een kwartier en nog niet goed. Hoe sluit ik dat bestand normaal met Verkenner? Alt+F4 en Ctrl+W gedaan geen resultaat. Verwijderen kan niet want document staat open. Niet te zien op taakbalk, niet in systeemvak, niet in taakbeheer, het is een raadsel.

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

 

[edmoor]

Die ~$Maak Windows Snelkoppelingen is het tijdelijjke bestand dat door Excel wordt gemaakt bij het openen van het document.
Dat zou weer moeten verdwijnen als Excel wordt gesloten met oEXC.Application.Quit
Waarom Excel bij jou niet wordt gesloten weet ik helaas niet, dat werkt hier goed.

Wordt het document tijdens openen wellicht ergens gewijzigd?
Zet dan dit eens voor die regel:
oEXC.ActiveWorkbook.Saved=True

 

[Senso]

Ja, dat is duidelijk. Echter je kunt het document later niet normaal meer openen > want is geopend, alleen lezen, niet bewerken, procedure opslaan etc. allermaal moeilijk. Nu taskkill gedaan en 4 processen gesloten.
taskkill /f /im excel.exe /fi “USERNAME eq %USERNAME%”

Waarom zou het document ergens gewijzigd worden? Ik voer het script uit en that's it.

Regel toegevoegd. Sluit nog steeds niet. Bij opening alleen lezen en bestand zou beveiligd zijn wat natuurlijk onzin is. Kan ik niet vinden. Taskill opnemen in vbs? Ga weer naar oude pc, kijken wat die daar doet.

 

[edmoor]

Het zou gewijzigd kunnen worden als er in de Workbook_Open daar ergens een opdracht voor staat.
Ik heb er geen last van dus is het voor mij ook gissen.
Gebruik dit eens in plaats van oEXC.Application.Quit:
Shell.Exec "taskkill /f /im EXCEL.EXE"

Dat doet het hier ook goed.