Usamos cookies para medir audiência e melhorar sua experiência. Você pode aceitar ou recusar a qualquer momento. Veja sobre o iMasters.
Boa noite.
Estou necessitando descobrir o nome do usuário do Computador, pois meu aplicativo instala um atalho na área de trabalho, sendo assim, cada computador tem um usuário diferente e não consegui achar uma solução para o problema.
O código que uso para criar o atalho é o que demonstro abaixo:
Select Case lblTipo.Caption
Case Is = "AI"
lReturn = fCreateShellLink("C:\Documents and Settings\**All Users ou Administrador**\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso.">
Tenta colocar
lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
Obrigado novamente pelas respostas, entretanto não funcionou.
Será que não há a necessidade de declarar alguma variável?
O código e as declarações estão como abaixo:
Option Explicit
Private Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Dim lReturn As Long
Private Sub cmdNao_Click()
Unload Me
End Sub
Private Sub cmdSim_Click()
Select Case lblTipo.Caption
Case Is = "AI"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
frmDistribuidor.cmdAtalhoAI.Visible = True
frmDistribuidor.Image1.Enabled = False
Case Is = "Reco"
lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
frmDistribuidor.cmdAtalhoReco.Visible = True
frmDistribuidor.Image5.Enabled = False
Case Is = "DD"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."
frmDistribuidor.cmdAtalhoDD.Visible = True
frmDistribuidor.Image2.Enabled = False
Case Is = "PS"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."
frmDistribuidor.cmdAtalhoPS.Visible = True
frmDistribuidor.Image3.Enabled = False
Case Is = "BFC"
lReturn = fCreateShellLink("C:\Documents and Settings\Administrador\Desktop", _
"Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."
frmDistribuidor.cmdAtalhoBFC.Visible = True
frmDistribuidor.Image4.Enabled = False
End SelectObs: Utilizei sua sugestão no CASE Reco.
valeu.
Digite %USERPROFILE% no executar e dê enter. Veja para qual pasta te manda.
Ele me mandou para:
"C:\Documents and Settings\Administrador".
O que pode estar errado?
O nome do usuário é Administrador. Não é isso que você quer ?
Desculpe não ter sido preciso na resposta.
Constando no executar sou remetido para o local certo, entretanto quando utilizo no código (lReturn = fCreateShellLink("%USERPROFILE%\Desktop") não tenho retorno.
Tenta isso.
Dim fso
Dim Wshshell
Set WshShell = Wscript.CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Win, UPD,Syst
Win = fso.GetSpecialFolder(0)
UPD = Wshshell.SpecialFolders("Desktop")
MsgBox UPD
1º deu erro informando que a variável não havia sido definida (Wscript).
Eu a defini junto com a outra (Dim Wshshell, Wscript).
Daí deu " Objeto requerido, erro 424, setando para: Set Wshshell = Wscript.CreateObject("Wscript.Shell").
não faço a menor idéia do que fazer.
agradeço.
PS>: no executável o erro é o mesmo (424)
Esse código é de VBS. Também não sei o que é WScript.
Esperimenta tirar o "WScript.".
Se não der certo veja isso:
Vai em um módulo.
Attribute VB_Name = "mod_SpecialFolders"
Option Explicit
''
Private Const CSIDL_DESKTOP As Long = &H0
Private Const CSIDL_INTERNET As Long = &H1
Private Const CSIDL_PROGRAMS As Long = &H2
Private Const CSIDL_CONTROLS As Long = &H3
Private Const CSIDL_PRINTERS As Long = &H4
Private Const CSIDL_PERSONAL As Long = &H5
Private Const CSIDL_FAVORITES As Long = &H6
Private Const CSIDL_STARTUP As Long = &H7
Private Const CSIDL_RECENT As Long = &H8
Private Const CSIDL_SENDTO As Long = &H9
Private Const CSIDL_BITBUCKET As Long = &HA
Private Const CSIDL_STARTMENU As Long = &HB
Private Const CSIDL_MYDOCUMENTS As Long = &HC
Private Const CSIDL_MYMUSIC As Long = &HD
Private Const CSIDL_MYVIDEO As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Private Const CSIDL_DRIVES As Long = &H11
Private Const CSIDL_NETWORK As Long = &H12
Private Const CSIDL_NETHOOD As Long = &H13
Private Const CSIDL_FONTS As Long = &H14
Private Const CSIDL_TEMPLATES As Long = &H15
Private Const CSIDL_COMMON_STARTMENU As Long = &H16
Private Const CSIDL_COMMON_PROGRAMS As Long = &H17
Private Const CSIDL_COMMON_STARTUP As Long = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Private Const CSIDL_APPDATA As Long = &H1A
Private Const CSIDL_PRINTHOOD As Long = &H1B
Private Const CSIDL_LOCAL_APPDATA As Long = &H1C
Private Const CSIDL_ALTSTARTUP As Long = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
''
Private Const CSIDL_COMMON_FAVORITES As Long = &H1F
Private Const CSIDL_INTERNET_CACHE As Long = &H20
Private Const CSIDL_COOKIES As Long = &H21
Private Const CSIDL_HISTORY As Long = &H22
Private Const CSIDL_COMMON_APPDATA As Long = &H23
Private Const CSIDL_WINDOWS As Long = &H24
Private Const CSIDL_SYSTEM As Long = &H25
Private Const CSIDL_PROGRAM_FILES As Long = &H26
Private Const CSIDL_MYPICTURES As Long = &H27
Private Const CSIDL_PROFILE As Long = &H28
Private Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Private Const CSIDL_COMMON_TEMPLATES As Long = &H2D
Private Const CSIDL_COMMON_DOCUMENTS As Long = &H2E
Private Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Private Const CSIDL_ADMINTOOLS As Long = &H30
Private Const CSIDL_CONNECTIONS As Long = &H31
Private Const CSIDL_COMMON_MUSIC As Long = &H35
Private Const CSIDL_COMMON_PICTURES As Long = &H36
Private Const CSIDL_COMMON_VIDEO As Long = &H37
Private Const CSIDL_RESOURCES As Long = &H38
Private Const CSIDL_RESOURCES_LOCALIZED As Long = &H39
Private Const CSIDL_COMMON_OEM_LINKS As Long = &H3A
Private Const CSIDL_CDBURN_AREA As Long = &H3B
Private Const CSIDL_COMPUTERSNEARME As Long = &H3D
''
Public Enum SpecialFolders
''
Desktop = CSIDL_DESKTOP
Internet = CSIDL_INTERNET
Programs = CSIDL_PROGRAMS
Controls = CSIDL_CONTROLS
Printers = CSIDL_PRINTERS
Personal = CSIDL_PERSONAL
Favorites = CSIDL_FAVORITES
Startup = CSIDL_STARTUP
Recent = CSIDL_RECENT
SendTo = CSIDL_SENDTO
BitBucket = CSIDL_BITBUCKET
StartMenu = CSIDL_STARTMENU
MyDocuments = CSIDL_MYDOCUMENTS
MyMusic = CSIDL_MYMUSIC
MyVideo = CSIDL_MYVIDEO
DesktopDirectory = CSIDL_DESKTOPDIRECTORY
Drives = CSIDL_DRIVES
Network = CSIDL_NETWORK
NetHood = CSIDL_NETHOOD
Fonts = CSIDL_FONTS
Templates = CSIDL_TEMPLATES
Common_StartMenu = CSIDL_COMMON_STARTMENU
Common_Programs = CSIDL_COMMON_PROGRAMS
Common_Startup = CSIDL_COMMON_STARTUP
Common_DesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
AppData = CSIDL_APPDATA
PrintHood = CSIDL_PRINTHOOD
Local_AppData = CSIDL_APPDATA
AltStartup = CSIDL_ALTSTARTUP
Common_AltStartup = CSIDL_COMMON_ALTSTARTUP
''
Common_Favorites = CSIDL_COMMON_FAVORITES
Internet_Cache = CSIDL_INTERNET_CACHE
Cookies = CSIDL_COOKIES
History = CSIDL_HISTORY
Common_ApPData = CSIDL_COMMON_APPDATA
Windows = CSIDL_WINDOWS
System = CSIDL_SYSTEM
Program_Files = CSIDL_PROGRAM_FILES
MyPictures = CSIDL_MYPICTURES
Profile = CSIDL_PROFILE
Program_Files_Common = CSIDL_PROGRAM_FILES_COMMON
Common_Program_Files = CSIDL_PROGRAM_FILES_COMMON
Common_Templates = CSIDL_COMMON_TEMPLATES
Common_Documents = CSIDL_COMMON_DOCUMENTS
Common_AdminTools = CSIDL_COMMON_ADMINTOOLS
AdminTools = CSIDL_ADMINTOOLS
Connections = CSIDL_CONNECTIONS
Common_Music = CSIDL_COMMON_MUSIC
Common_Pictures = CSIDL_COMMON_PICTURES
Common_Video = CSIDL_COMMON_VIDEO
Resources = CSIDL_RESOURCES
Resources_Localized = CSIDL_RESOURCES_LOCALIZED
Common_OEM_Links = CSIDL_COMMON_OEM_LINKS
CDBurn_Area = CSIDL_CDBURN_AREA
ComputersNearMe = CSIDL_COMPUTERSNEARME
''
End Enum
''
Private Type SHITEMID
cb As Long
abID As Byte
End Type
''
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
''
Public Function GetSpecialfolder(CSIDL As Long) As String
''
Dim r As Long
Dim IDL As ITEMIDLIST
Dim strPath As String
''
Const NOERROR = 0
'Const MAX_LENGTH = 260'
''
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = NOERROR Then
strPath = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
GetSpecialfolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
End If
''
End Function
Valeu Scorpio, mas desta vez não deu.
Está ficando muito complicado por pouco.
Vou alterar meu aplicativo, solicitando que o usuário digite o nome do usuário do PC em um determinado campo,
assim posso atravéz de variável colocar o nome dele no lugar que necessito.
Um abraço e muito obrigado pelas tentativas.
Testou esse ultimo código ?
Coloca em um módulo.
Quando quiser o desktop coloca :
Msgbox GetSpecialfolder(SpecialFolders.Desktop)
>
Testou esse ultimo código ?
Coloca em um módulo.
Quando quiser o desktop coloca :
Msgbox GetSpecialfolder(SpecialFolders.Desktop)
Não entendi! Está ficando complicado demais.
Não creio que apenas copiando o último código em um módulo e
Msgbox GetSpecialfolder(SpecialFolders.Desktop), onde necessito fará com que o atalho de meu programa apareça no desktop. Deve estar faltando alguma coisa.
Option Explicit
Private Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Dim lReturn As Long
Private Sub cmdNao_Click()
Unload Me
End Sub
Private Sub cmdSim_Click()
Msgbox GetSpecialfolder(SpecialFolders.Desktop)
Select Case lblTipo.Caption
Case Is = "AI"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
frmDistribuidor.cmdAtalhoAI.Visible = True
frmDistribuidor.Image1.Enabled = False
Case Is = "Reco"
lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
frmDistribuidor.cmdAtalhoReco.Visible = True
frmDistribuidor.Image5.Enabled = False
Case Is = "DD"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."
frmDistribuidor.cmdAtalhoDD.Visible = True
frmDistribuidor.Image2.Enabled = False
Case Is = "PS"
lReturn = fCreateShellLink("C:\Documents and Settings\All Users\Desktop", _
"Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."
frmDistribuidor.cmdAtalhoPS.Visible = True
frmDistribuidor.Image3.Enabled = False
Case Is = "BFC"
lReturn = fCreateShellLink("C:\Documents and Settings\Administrador\Desktop", _
"Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."
frmDistribuidor.cmdAtalhoBFC.Visible = True
frmDistribuidor.Image4.Enabled = False
End SelectVocê quem sabe.
Só copiar não fará do nada aparecer no desktop mesmo. Não é mágica.
Com isso você terá o caminho do Desktop do usuário. Certo?
Não é isso que você precisa para criar o atalho ?
Vou explicar de novo.
Cria um módulo e coloca o seguinte código:
Option Explicit
''
Private Const CSIDL_DESKTOP As Long = &H0
Private Const CSIDL_INTERNET As Long = &H1
Private Const CSIDL_PROGRAMS As Long = &H2
Private Const CSIDL_CONTROLS As Long = &H3
Private Const CSIDL_PRINTERS As Long = &H4
Private Const CSIDL_PERSONAL As Long = &H5
Private Const CSIDL_FAVORITES As Long = &H6
Private Const CSIDL_STARTUP As Long = &H7
Private Const CSIDL_RECENT As Long = &H8
Private Const CSIDL_SENDTO As Long = &H9
Private Const CSIDL_BITBUCKET As Long = &HA
Private Const CSIDL_STARTMENU As Long = &HB
Private Const CSIDL_MYDOCUMENTS As Long = &HC
Private Const CSIDL_MYMUSIC As Long = &HD
Private Const CSIDL_MYVIDEO As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Private Const CSIDL_DRIVES As Long = &H11
Private Const CSIDL_NETWORK As Long = &H12
Private Const CSIDL_NETHOOD As Long = &H13
Private Const CSIDL_FONTS As Long = &H14
Private Const CSIDL_TEMPLATES As Long = &H15
Private Const CSIDL_COMMON_STARTMENU As Long = &H16
Private Const CSIDL_COMMON_PROGRAMS As Long = &H17
Private Const CSIDL_COMMON_STARTUP As Long = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Private Const CSIDL_APPDATA As Long = &H1A
Private Const CSIDL_PRINTHOOD As Long = &H1B
Private Const CSIDL_LOCAL_APPDATA As Long = &H1C
Private Const CSIDL_ALTSTARTUP As Long = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
''
Private Const CSIDL_COMMON_FAVORITES As Long = &H1F
Private Const CSIDL_INTERNET_CACHE As Long = &H20
Private Const CSIDL_COOKIES As Long = &H21
Private Const CSIDL_HISTORY As Long = &H22
Private Const CSIDL_COMMON_APPDATA As Long = &H23
Private Const CSIDL_WINDOWS As Long = &H24
Private Const CSIDL_SYSTEM As Long = &H25
Private Const CSIDL_PROGRAM_FILES As Long = &H26
Private Const CSIDL_MYPICTURES As Long = &H27
Private Const CSIDL_PROFILE As Long = &H28
Private Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Private Const CSIDL_COMMON_TEMPLATES As Long = &H2D
Private Const CSIDL_COMMON_DOCUMENTS As Long = &H2E
Private Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Private Const CSIDL_ADMINTOOLS As Long = &H30
Private Const CSIDL_CONNECTIONS As Long = &H31
Private Const CSIDL_COMMON_MUSIC As Long = &H35
Private Const CSIDL_COMMON_PICTURES As Long = &H36
Private Const CSIDL_COMMON_VIDEO As Long = &H37
Private Const CSIDL_RESOURCES As Long = &H38
Private Const CSIDL_RESOURCES_LOCALIZED As Long = &H39
Private Const CSIDL_COMMON_OEM_LINKS As Long = &H3A
Private Const CSIDL_CDBURN_AREA As Long = &H3B
Private Const CSIDL_COMPUTERSNEARME As Long = &H3D
''
Public Enum SpecialFolders
''
Desktop = CSIDL_DESKTOP
Internet = CSIDL_INTERNET
Programs = CSIDL_PROGRAMS
Controls = CSIDL_CONTROLS
Printers = CSIDL_PRINTERS
Personal = CSIDL_PERSONAL
Favorites = CSIDL_FAVORITES
Startup = CSIDL_STARTUP
Recent = CSIDL_RECENT
SendTo = CSIDL_SENDTO
BitBucket = CSIDL_BITBUCKET
StartMenu = CSIDL_STARTMENU
MyDocuments = CSIDL_MYDOCUMENTS
MyMusic = CSIDL_MYMUSIC
MyVideo = CSIDL_MYVIDEO
DesktopDirectory = CSIDL_DESKTOPDIRECTORY
Drives = CSIDL_DRIVES
Network = CSIDL_NETWORK
NetHood = CSIDL_NETHOOD
Fonts = CSIDL_FONTS
Templates = CSIDL_TEMPLATES
Common_StartMenu = CSIDL_COMMON_STARTMENU
Common_Programs = CSIDL_COMMON_PROGRAMS
Common_Startup = CSIDL_COMMON_STARTUP
Common_DesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
AppData = CSIDL_APPDATA
PrintHood = CSIDL_PRINTHOOD
Local_AppData = CSIDL_APPDATA
AltStartup = CSIDL_ALTSTARTUP
Common_AltStartup = CSIDL_COMMON_ALTSTARTUP
''
Common_Favorites = CSIDL_COMMON_FAVORITES
Internet_Cache = CSIDL_INTERNET_CACHE
Cookies = CSIDL_COOKIES
History = CSIDL_HISTORY
Common_ApPData = CSIDL_COMMON_APPDATA
Windows = CSIDL_WINDOWS
System = CSIDL_SYSTEM
Program_Files = CSIDL_PROGRAM_FILES
MyPictures = CSIDL_MYPICTURES
Profile = CSIDL_PROFILE
Program_Files_Common = CSIDL_PROGRAM_FILES_COMMON
Common_Program_Files = CSIDL_PROGRAM_FILES_COMMON
Common_Templates = CSIDL_COMMON_TEMPLATES
Common_Documents = CSIDL_COMMON_DOCUMENTS
Common_AdminTools = CSIDL_COMMON_ADMINTOOLS
AdminTools = CSIDL_ADMINTOOLS
Connections = CSIDL_CONNECTIONS
Common_Music = CSIDL_COMMON_MUSIC
Common_Pictures = CSIDL_COMMON_PICTURES
Common_Video = CSIDL_COMMON_VIDEO
Resources = CSIDL_RESOURCES
Resources_Localized = CSIDL_RESOURCES_LOCALIZED
Common_OEM_Links = CSIDL_COMMON_OEM_LINKS
CDBurn_Area = CSIDL_CDBURN_AREA
ComputersNearMe = CSIDL_COMPUTERSNEARME
''
End Enum
''
Private Type SHITEMID
cb As Long
abID As Byte
End Type
''
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
''
Public Function GetSpecialfolder(CSIDL As Long) As String
''
Dim r As Long
Dim IDL As ITEMIDLIST
Dim strPath As String
''
Const NOERROR = 0
'Const MAX_LENGTH = 260'
''
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = NOERROR Then
strPath = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
GetSpecialfolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
End If
''
End Function
Daí, no seu botão cmdSim, faz:
Dim Caminho_Desktop as String
Caminho_Desktop = GetSpecialfolder(SpecialFolders.Desktop)
Se quiser, use como quiser o caminho.
Usuário odeia digitar.
Abraços!!
Acho que funcionou, porém tenho que testar o programa em máquina com usuário diferente do meu.
Por enquanto agradeço novamente, e compreendo como deve ser difícil lidar com a falta de conhecimento dos usuários.
Damos graças por existirem pessoas gabaritadas para nos auxiliar nas horas mais difíceis, e imagino como deve ser gratificante poder divulgar aos "sete cantos", nosso dom.
PS.: não sei falar chinês, quanto mais escrever, ou seja, não sou preguiçoso, apenas não tenho conhecimento suficiente para interpretar algo que não fui instruido a compreender.
Novamente Muito obrigado, e não pense que será minha última dúvida.
Sou Brasileiro e não desisto nunca.
PS II: Se funcionar retorno para postar.
OK.
Espero retornar para colocar resolvido.
Abraços!
Ainda não testei em outra máquina e já surgiu mais um problema.
Meu aplicativo pergunta ao usuário, para quais programas que ele está instalando, deseja criar um atalho na área de trabalho, da seguinte forma:
1) Num form principal existem ícones que quando clicados, além de instalar o programa, remete a outro form (frmAtalho):
Private Sub Image1_Click()
AbrePrograma = Shell(App.Path & "\Executável AI\Setup.exe", vbMaximizedFocus)
Image1.Enabled = False
AI = "AI"
frmAtalho.lblTipo.Caption = "AI"
frmAtalho.Show 1
End Sub
Private Sub Image2_Click()
AbrePrograma = Shell(App.Path & "\Executável DD\Setup.exe", vbMaximizedFocus)
DD = "DD"
Image2.Enabled = False
frmAtalho.lblTipo.Caption = "DD"
frmAtalho.Show 1
End Sub
2)Com o frmAtalho aberto, isto após abrir e instalar o respectivo aplicativo, pergunta se o usuário quer ou não instalar o atalho. Se sim o atalho é instalado;
Private Sub cmdSim_Click()
Dim Caminho_Desktop As String
Caminho_Desktop = GetSpecialfolder(SpecialFolders.Desktop)
Select Case lblTipo.Caption
Case Is = "AI"
lReturn = fCreateShellLink(Caminho_Desktop, _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
Text1 = lReturn
frmDistribuidor.cmdAtalhoAI.Visible = True
frmDistribuidor.Image1.Enabled = False
MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
Case Is = "Reco"
lReturn = fCreateShellLink(Caminho_Desktop, _
"Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
Text1 = lReturn
frmDistribuidor.cmdAtalhoReco.Visible = True
frmDistribuidor.Image5.Enabled = False
MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
Case Is = "DD"
lReturn = fCreateShellLink(Caminho_Desktop, _
"Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
Text1 = Caminho_Desktop
frmDistribuidor.cmdAtalhoDD.Visible = True
frmDistribuidor.Image2.Enabled = False
MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."
Case Is = "PS"
lReturn = fCreateShellLink(Caminho_Desktop, _
"Político Social", "C:\Arquivos de programas\Banco de Dados Político Social\BDPS Politico Social.exe", "")
Text1 = Caminho_Desktop
frmDistribuidor.cmdAtalhoPS.Visible = True
frmDistribuidor.Image3.Enabled = False
MsgBox "Atalho do aplicativo <Político Social> criado com sucesso."
Case Is = "BFC"
lReturn = fCreateShellLink(Caminho_Desktop, _
"Base Fotográfica Criminal", "C:\Arquivos de programas\PrjBasFCrim\Cadastro Criminal.exe", "")
Text1 = Caminho_Desktop
frmDistribuidor.cmdAtalhoBFC.Visible = True
frmDistribuidor.Image4.Enabled = False
MsgBox "Atalho do aplicativo <Base Fotográfica Criminal> criado com sucesso."
End Select
Unload MeQUAL O PROBLEMA QUE SURGIU.
O form fica aberto enquanto o usuário clica em cada programa para instalação, abre o formAtalho e o fecha.
Ocorre porém que só instá-la o 1º atalho os demais não.
Só consigo instalar os outros atalhos fechando o programa e abrindo-o para instalar cada aplicativo.
Talvez tenha que fazer com que a variável ou a função seja resetada da memória antes de pedir para instalar o outro atalho, entretanto não sei como fazer isto.
Teriamos alguma sugestão para este caso?
Obrigado novamente e novamente.
Scorpio, funcionou perfeitamente em outro computador, porém como disse no recado anterior, não
consigo instalar mais de um aplicativo por vez, ou seja tenho que reiniciar o meu executável.
Se não for pedir demais tem como resolver este problema também?
Agradeço.
Tenta isso, logo que depois que criar um atalho:
Unload Me
Load Me
Me.Show
Scorpio.
Não funcionou.
Só consigo instalar outro atalho fechando o aplicativo e iniciando-o novamente.
Relembrando:
No 1º form clico na imagem1. ela instala o aplicativo e abre o formAtalho, onde clico em cmdSim para instalar
o respectivo atalho.
O formAtalho fecha e retorna ao 1º form para a instalação de outro aplicativo e consequentemente abre o formAtalho
que pergunta se quero instalar o atalho deste outro aplicativo, assim sucessivamente até o último.
Não seria alguma variavel ou função que necessita ser "zerada" para ganhar outro valor?
Valeu, estou no aguardo de auxílio, pois meus conhecimentos são insuficientes.
um abraço.
PS: gostaria de mostras as fotos dos forms, mas não sei como fazer.
TIra isso do seu form e poe em um módulo.
Public Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Deixe como Public.
Veja se dá segunda vez que você executa, o caminho do desktop ainda é recuperado.
Scorpio, não adiantou.
Mudei até meu form para testar com botões, mas não deu.
Se puder analise meu código, está tudo como você ensinou:
Option Explicit
Dim Caminho_Desktop As String
Private Sub Command1_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
Call fCreateShellLink(Caminho_Desktop, _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")
MsgBox "Atalho do aplicativo <Assuntos Internos> criado com sucesso."
End Sub
Private Sub Command2_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
Call fCreateShellLink(Caminho_Desktop, _
"Reconhecimento Fotográfico", "C:\Arquivos de programas\Assuntos Internos\fotos\PrjRecoFoto.exe", "")
MsgBox "Atalho do aplicativo <Reconhecimento Fotográfico> criado com sucesso."
End Sub
Private Sub Command3_Click()
Caminho_Desktop = "C:\Documents and Settings\Administrador\Desktop"
Call fCreateShellLink(Caminho_Desktop, _
"Disque Denúncia - (181)", "C:\Arquivos de programas\Disque Denúncia\Disque Denúncia - 181.exe", "")
MsgBox "Atalho do aplicativo <Disque Denúncia - (181)> criado com sucesso."
End Sub
E num módulo modulo constei como disse:
Public Declare Function fCreateShellLink Lib "vb6stkit.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Pergunta: Não teria uma forma de "zerar" o valor de "fCreateShellLink"?
Valeu novamente.
Não sei mais o que pode ser.
Tenta criar o atalho de outra maneira.
Scorpio valeu por todas as dicas que me passou, foram de grande valor, só que meu projeto verifica quais aplicativos, entre os 5 possíveis, o cliente intalou e quer adicionar o atalho, então fica difícil individualizar os formulários para as perguntas sobre o atalho.
O tópico em si foi resolvido, portanto creio que pode constar como tal, entretanto vou abrir outro para verificar se alguém sabe como "zerar" a função
fCreateShellLink, a fim de utilizá-la no mesmo formulário para instalar outro aplicativo.
Valeu por enquanto, pois é certo que novas dúvidas surgiram, inclusive esta.
Um abraço, valeu.
Não há necessidade de abrir outro tópico.
Quanto a limpar a função, não conheço nada que o faça e nem nada que impeça de executar a função.
Tente fazer o restart de forma automatica se não ficar lento.
Scorpio, voltei!
Agora para participar que "inventei" uma solução para a impossibilidade de criar mais de um atalho num mesmo projeto.
Quando o usuário pede para instalar um aplicativo, direciono-o para o formAtalho, que através do Shell abre e fecha um executável(visible=false) que faz a função "fCreateShellLink", assim sucessivamente com todos os outros aplicativos, ou seja, abre e fecha seu respectivo executável, como nas fórmulas abaixo.
Private Sub Image1_Click()
AbrePrograma = Shell(App.Path & "\Executável AI\Setup.exe", vbMaximizedFocus)
Image1.Enabled = False
AI = "AI"
frmAtalho.lblTipo.Caption = "AI"
frmAtalho.Show 1
End Sub
Private Sub Image2_Click()
AbrePrograma = Shell(App.Path & "\Executável DD\Setup.exe", vbMaximizedFocus)
DD = "DD"
Image2.Enabled = False
frmAtalho.lblTipo.Caption = "DD"
frmAtalho.Show 1
End Sub
Private Sub Image3_Click()
AbrePrograma = Shell(App.Path & "\Executável PS\Setup.exe", vbMaximizedFocus)
PS = "PS"
Image3.Enabled = False
frmAtalho.lblTipo.Caption = "PS"
frmAtalho.Show 1
End Sub
Private Sub Image4_Click()
AbrePrograma = Shell(App.Path & "\Executável BFC\Setup.exe", vbMaximizedFocus)
BFC = "BFC"
Image4.Enabled = False
frmAtalho.lblTipo.Caption = "BFC"
frmAtalho.Show 1
End Sub
Private Sub Image5_Click()
Image5.Enabled = False
frmAtalho.lblTipo.Caption = "Reco"
frmAtalho.Show 1
End Sub
Abre o frmAtalho:
Private Sub cmdSim_Click()
Select Case lblTipo.Caption
Case Is = "AI"
AbrePrograma = Shell(App.Path & "\Atalhos\AI_atalho.exe", vbNormalFocus)
frmDistribuidor.cmdAtalhoAI.Visible = True
frmDistribuidor.Image1.Enabled = False
Case Is = "Reco"
AbrePrograma = Shell(App.Path & "\Atalhos\RECO_atalho.exe", vbNormalFocus)
frmDistribuidor.cmdAtalhoReco.Visible = True
frmDistribuidor.Image5.Enabled = False
Case Is = "DD"
AbrePrograma = Shell(App.Path & "\Atalhos\DD_atalho.exe", vbNormalFocus)
frmDistribuidor.cmdAtalhoDD.Visible = True
frmDistribuidor.Image2.Enabled = False
Case Is = "PS"
AbrePrograma = Shell(App.Path & "\Atalhos\PS_atalho.exe", vbNormalFocus)
frmDistribuidor.cmdAtalhoPS.Visible = True
frmDistribuidor.Image3.Enabled = False
Case Is = "BFC"
AbrePrograma = Shell(App.Path & "\Atalhos\BFC_atalho.exe", vbNormalFocus)
frmDistribuidor.cmdAtalhoBFC.Visible = True
frmDistribuidor.Image4.Enabled = False
End Select
Unload MeQue abre e instala seu respectivo atalho.
Valeu cara, muito obrigado pelas informações e tentativas de auxiliar-me.
Pode carimbar como resolvido.
Valeu...
Tenta colocar
lReturn = fCreateShellLink("%USERPROFILE%\Desktop", _
"Assuntos Internos", "C:\Arquivos de programas\Assuntos Internos\Controle Effetivo2009.exe", "")