Wednesday, May 23, 2012

Using VBA code to create a shortcut on users' desktops

'----------------------------------------------------------------
Sub CreateShortCut()
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String

Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")

Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing

End Sub
'----------------------------------------------------------------

2 comments:

  1. Awesome post. This really help me out with writing a userform in VBA for Sales Monitoring.


    Private Sub CommandButton1_Click()
    '===============================================
    'FIND IF FOLDER\FILE ALREADY EXISTS
    '===============================================
    thesentence = ("C:\Sales Monitoring\")

    If Dir(thesentence) <> "" Then
    MsgBox "Software is already installed."
    Else
    MsgBox "Software not installed. Click okay to install now."
    '===============================================
    'COPY FROMPATH TO TOPATH ALL CONTENTS OF SALES MONITORING CLC FILES
    '===============================================
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\rekcah6903\Desktop\Sales Monitoring" '<< Change
    ToPath = "C:\Sales Monitoring" '<< Change

    FileExt = "*.xl*" '<< Change

    'You can use *.* for all files or *.doc for word files
    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then
    FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
    ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

    '===============================================
    'DESKTOP SHORTCUT (http://mgm-excel-vba.blogspot.com/2012/05/using-vba-code-to-create-shortcut-on.html)
    '===============================================
    Dim oWSH As Object
    Dim oShortcut As Object
    Dim sPathDeskTop As String

    Set oWSH = CreateObject("WScript.Shell")
    sPathDeskTop = oWSH.SpecialFolders("Desktop")

    Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
    ActiveWorkbook.Name & ".lnk")
    With oShortcut
    .TargetPath = "C:\Sales Monitoring\Call Log Card.xlsm"
    .Save
    End With
    Set oWSH = Nothing
    '===============================================

    End If
    End Sub

    ReplyDelete
  2. Excellent code. It was very help me.
    Many Thanks,

    ReplyDelete