Criando atalhos no VB

Que tal um programa feito em Visual Basic para criar atalhos para qualquer aplicação. Para começar vou mostrar o formulário do projeto em execução . Na figura abaixo eu estou criando um atalho para o aplicativo Visdata.exe com o nome de Visdata em c:\Windows\Desktop

Inicie um novo projeto no VB tipo Standard EXE e insira no formulário os seguintes controles :

• 2 componentes TextBox alterando seus nomes para : txtPath e txtNome
  
  
• 3 componentes CommandButton com os seguintes nomes : cmdBrowse , cmdCria , cmdExclui
  
  
• Inclua os seguintes componentes : DriveListBox - Drive1 , DirListBox - Dir1 e FileListBox - File1
  
  
• 1 componente CommonDialog com o nome de dlg
  
  
• 1 componente ListBox com o nome de lst
  
  

Faça uma referência através do menu Project|References a biblioteca - Windows Script Host Object Model
1- Na seção General Declarations informe :
Option Explicit
Dim wShell As IWshShell_Class

2- No evento Load do formulário digite o código :

Private Sub Form_Load() Dim temp Set wShell = New IWshShell_Class For Each temp In wShell.SpecialFolders    lst.AddItem temp    If InStr(temp, "Start Menu") <> 0 Then lst.ListIndex = lst.ListCount - 1 Next End Sub

3- Agora no evento click dos componentes : DriveListBox , DirListBox e ListBox temos o código:

Private Sub Drive1_Change()      Dir1.Path = Drive1.Drive & "\" End Sub

Private Sub Dir1_Change()     File1.Path = Dir1.List(Dir1.ListIndex)     If File1.ListCount > 0 Then File1.ListIndex = 0 End Sub

Private Sub lst_Click()    Drive1.Drive = Left(lst.List(lst.ListIndex), 2)    Dir1.Path = lst.List(lst.ListIndex) End Sub

4- Agora o código do evento Click dos botões - CmdCria , CmdExclui e CmdProcura:

'Cria um atalho Private Sub cmdCria_Click() On Error Resume Next Dim wShortcut As IWshShortcut_Class If Dir(txtPath) = "" Then    MsgBox "Aplicação não localizada..." ElseIf Trim(txtName) = "" Then    MsgBox "Nome do atalho esta faltando." Else    Set wShortcut = wShell.CreateShortcut(Dir1.Path & "\" & txtName & ".lnk")    wShortcut.TargetPath = txtPath    wShortcut.Save    File1.Refresh End If    If Err <> 0 Then MsgBox "Impossível criar atalho" End Sub 'Exclui um atalho Private Sub cmdExclui_Click()     If File1.ListIndex > -1 Then          Kill File1.Path & "\" & File1.FileName          File1.Refresh          If File1.ListCount > 0 Then File1.ListIndex = 0     End If End Sub

'Procura por uma aplicação Private Sub cmdProcura_Click()    dlg.FileName = "*.exe"    dlg.ShowOpen    txtPath = dlg.FileName End Sub

Com pouco código temos uma aplicação bem legal ...
Creio que a novidade seja a utilização do Windows Script Host Object Model. Vale a pena dar uma olhada no Help do VB sobre ele.

http://www.macoratti.net/d181103.htm