You used a form control button which is fine. The user's problem may be that they have their security set at High or they chose not to click the Enable Macros button for a medium security. In Excel 2007+, it is fairly obvious that macros should be enabled for an xlsm file. For an xls file, some users never want macros enabled.
When a spreadsheet must have macros enabled, some hide their sheets by code when it closes except for an informative sheet. Obviously, you need it password protected in that scenario as well. When macros are enabled, the Open event is coded to unhide the sheets and unprotect as needed.
The icon was not created for me but the shortcut was when the file was opened in my temp folder. When I saved the file, deleted the shortcut, clicking the button did nothing.
If you will restructure your code for the IF() loops, I think that you will see why the 2nd run does not work. It is because "C:\Desktop Shortcut" path already exists so it does nothing. I see no reason for the Else. If you explain in words what it should do, I could fix it for you. e.g. Put on Desktop if desktop path is found. If desktop path does not exist, create "C:\Desktop Shortcut" path. And so on...
I think the structure for the code without your Else would be:
Sub Desktop_Shortcut()
Dim WBName As String, Path As String, WB_Link As String, WB_Name As String
Dim DesktopPath As String, TargetPath As String, StrSave As String
Dim WSHShell As Object, MyShortcut As Object
Set WSHShell = CreateObject("WScript.Shell")
Dim FSO As Object, Folder As Object, File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WB As Workbook
Set WB = ThisWorkbook
Dim WSh As Worksheet
Set WSh = Sheet1
WBName = WB.Name
Path = "MyFile"
DesktopPath = WSHShell.SpecialFolders("Desktop")
WSh.Range("C2").Value = WB.Name
WB_Name = WSh.Range("C3").Value
WB_Link = WSh.Range("C4").Value
On Error GoTo ErrHandle
If Not DirExists("C:\" & WB_Name) Then 'Check C Drive
If Not DirExists(GetSpecialFolder(CSIDL_PERSONAL) & "\" & WB_Name) Then 'Check My Documents
Set FSO = CreateObject("Scripting.FileSystemObject") 'If not in C Drive or My Documents - then create shortcut
FSO.CreateFolder "C:\" & WB_Name
ChDir "C:\" & WB_Name
SavePicture Sheet1.Image1.Picture, WB_Name & ".ico" 'Picture pasted onto Image1 on Sheet 1 - Link Shortcut
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & WB_Link)
With MyShortcut
.TargetPath = WB.FullName
.IconLocation = "C:\" & WB_Name & "\" & WB_Name & ".ico"
.WindowStyle = 1
.Description = "EEZIAdmin"
.WorkingDirectory = WB.Path
.Save
End With
End If
End If
ErrHandle:
Set WSHShell = Nothing
End Sub
Display logo pasted to worksheet as icon on desktop shortcut
Reply With Quote
