EXCEL VBA フォルダー・ファイルのショートカット作成（アプリケーション・共有フォルダー・URLのショートカット）

EXCEL VBA フォルダーのショートカット作成・ファイルのショートカット作成（アプリケーション・共有フォルダー・URL）

EXCEL VBA 　デスクトップ上にフォルダーのショートカットを作成

'
'******** AKIRA55.COM ******* https://akira55.com/shortcut/
'
Sub shortcut01()  'デスクトップ上にフォルダーのショートカットを作成する
 
  Dim WshShell As Object
  Dim DeskTopPath, ShortCutPath As String
   
 
  Set WshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
 
  DeskTopPath = WshShell.SpecialFolders("Desktop") 'デスクトップパスを取得する
  
  ShortCutPath = DeskTopPath & "\サンプルフォルダー" & ".lnk" 'ショートカット名の指定

   
  With WshShell.CreateShortcut(ShortCutPath)
          
      .TargetPath = "C:\Users\akira\OneDrive\01_開発中\サンプルフォルダー"    'ショートカットのリンク先を設定
      
      .WorkingDirectory = "C:\Users\akira\OneDrive\" '作業フォルダ
      
      .Hotkey = "Ctrl+Alt+Z"
      
      .WindowStyle = 1  '標準：１・最大化：３・最小化：７
      
      .Description = "ショートカットテストです。" 'コメント欄の表記文字を設定
      
      .IconLocation = "%SystemRoot%\system32\SHELL32.dll, 80"  'アイコンの設定 80番アイコン
  
      .Save 'ショートカットの保存実行
  End With
 
  Set WshShell = Nothing
 
End Sub
'

EXCEL VBA 　ファイルのショートカット作成（自身のEXCELファイルのショートカット）

'
'******** AKIRA55.COM ******* https://akira55.com/shortcut/
'
Sub shortcut02()  'デスクトップ上にファイルのショートカットを作成する
 
  Dim WshShell As Object
  Dim DeskTopPath, ShortCutPath As String
   
 
  Set WshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
 
  DeskTopPath = WshShell.SpecialFolders("Desktop") 'デスクトップパスを取得する
  
  ShortCutPath = DeskTopPath & "\" & ThisWorkbook.Name & ".lnk" 'ショートカット名の指定（このブックのショートカット名）
   
  With WshShell.CreateShortcut(ShortCutPath)
          
      .TargetPath = ThisWorkbook.FullName  'ショートカットのリンク先を設定(このブック)
      
      .Save 'ショートカットの保存実行
  End With
 
  Set WshShell = Nothing
 
End Sub
'

EXCEL VBA インターネットURLのショートカット作成

'
'******** AKIRA55.COM ******* https://akira55.com/shortcut/
'
Sub shortcut03()   'デスクトップ上にインターネットURLのショートカットを作成する
 
  Dim WshShell As Object
  Dim DeskTopPath, ShortCutPath As String
   
 
  Set WshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
 
  DeskTopPath = WshShell.SpecialFolders("Desktop") 'デスクトップパスを取得する
  
  ShortCutPath = DeskTopPath & "\" & "Yahoo!JAPAN.URL"  'ショートカット名の指定（URLショートカット名）
  
  With WshShell.CreateShortcut(ShortCutPath)
          
      .TargetPath = "https://www.yahoo.co.jp/"  'ショートカットのリンク先を設定(YahooのURLを指定)
      
      .Save 'ショートカットの保存実行
  End With
 
  Set WshShell = Nothing
 
End Sub
'

EXCEL VBA アプリケーションソフト（ペイント）のショートカット作成

'
'******** AKIRA55.COM ******* https://akira55.com/shortcut/
'
Sub shortcut04()   'デスクトップ上にペイント（アプリケーション）のショートカットを作成する
 
  Dim WshShell As Object
  Dim DeskTopPath, ShortCutPath As String
   
 
  Set WshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
 
  DeskTopPath = WshShell.SpecialFolders("Desktop") 'デスクトップパスを取得する
  
  
  ShortCutPath = DeskTopPath & "\" & "ペイント.lnk"  'ショートカット名の指定（ペイント）
  
  With WshShell.CreateShortcut(ShortCutPath)
        
      .TargetPath = "%windir%\system32\mspaint.exe"  'ショートカットのリンク先を設定(ペイントのEXEを指定)
      .Save 'ショートカットの保存実行
  
  End With
 
 
  Set WshShell = Nothing
 
End Sub
'