Atalhos no vb6.0

Criando atalhos no Visual Basic

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_ClassFor 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_ClassIf Dir(txtPath) = "" Then MsgBox "Aplicação não localizada..."
ElseIf Trim(txtName) = "" Then MsgBox "Nome do atalho esta faltando."