Create a shortcut to the current active workbook in a specific directory

[account123]

Hi everyone,

I need a VBA script to insert into my module that simply creates a shortcut to the current active workbook in the following directory "D:\Work\Expense Report"

Thank you and have a nice day

 

[Kenneth Hobson]

Welcome to the forum!

'https://msdn.microsoft.com/en-us/library/xsy6k3ys(v=vs.84).aspx
Sub Main()
  Dim scPath As String, scName As String
  Dim sPathFile, oWsh As Object
  
  scPath = "D:\Work\Expense Report\"
  scName = scPath & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "lnk"
  sPathFile = ThisWorkbook.FullName
  
  Set oWsh = CreateObject("WScript.Shell")
  With oWsh.CreateShortcut(scName)
    .TargetPath = sPathFile
    .IconLocation = CreateObject("Wscript.Shell").RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\excel.exe\")
    .Save
  End With
End Sub