'----------------------------------------------------------------
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
'----------------------------------------------------------------
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
'----------------------------------------------------------------
Awesome post. This really help me out with writing a userform in VBA for Sales Monitoring.
ReplyDeletePrivate 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
Excellent code. It was very help me.
ReplyDeleteMany Thanks,