Mara:
Hace unos meses tuve que crear un módulo que hace lo que vos querés, la diferencia radica es que recibe el path del programa con una línea de órdenes. A continuación lo pego, es fácil de adaptar. Si tenés más dudas abrí una ventana de consola y teclea runas /?
Option Explicit
DefLng A-Z
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Const STD_OUTPUT_HANDLE = -11&
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'############################################################################
'CONSTANTES (INICIO)
'############################################################################
Private Const DominioUsuario As String = "GRUPODETRABAJO\Administrador"
Private Const Password As String = "PASSWORD"
'############################################################################
'CONSTANTES (FIN)
'############################################################################
'Bug: A veces, Sendkeys no envía la contraseña correctamente. Ocurre cuando hay otra consola abierta
'Para que el programa funcione, no debe haber otra consola abierta
'Nota: La siguiente línea sirve para escribir texto en la consola ('sOut contiene el texto que quiere escrfibirse, cWritten el número de caracteres escritos)
'Result = WriteConsole(hConsole, ByVal sOut, Len(sOut), cWritten, ByVal 0&)
'El módulo lee la línea de comandos para saber que programa ejecuta
'Cambiá los argumentos de la línea de comandos del proyecto. Está puesta my versión del interdev ubicado en D:\...
Public Sub Main()
On Error Resume Next
Dim hConsole As Long, l As Long, lExitCode As Long
Dim Result As Long, sOut As String, cWritten As Long, r As Single, strCmd As String
strCmd = Command$ 'lee la línea de comandos
If Left$(strCmd, 1) <> Chr$(34) Then Chr$ (34) & strCmd 'Si falta la comilla izquierda la coloca
If Right$(strCmd, 1) <> Chr$(34) Then Chr$ (34) & strCmd 'Si falta la comilla derecha la coloca
If AllocConsole() Then 'Asigna una nueva consola al proceso llamante.
hConsole = GetStdHandle(STD_OUTPUT_HANDLE) 'Obtiene el manejador de consola
If hConsole = 0 Then MsgBox "No se pudo iniciar la consola" 'Si falló devuelve mensaje
Else
MsgBox "No se pudo iniciar la consola" 'Si no puede asignar una conslola, devuelve mensaje
End If
'Corre un programa de consola, al estar tomada la consola por nuestro proceso,
'todo instrucción que corre por consola va a parar a nuestra consola y a ninguna otra
r = Shell("runas /user:" & DominioUsuario & " " & strCmd)
'Espera 500 ms para permitir la carga del programa runas en la consola
Wait 500
'Activa la ventana de la consola
AppActivate r
'Tipea el password en la ventana activa e introduce un enter
SendKeys Password & "{ENTER}"
'Espera 500 milisegundos para que efectivice la llamada (una eternidad)
Wait 500
CloseHandle hConsole 'Cierra la consola
FreeConsole 'Libera recursos
Wait 500
End Sub
Private Sub Wait(ByVal tm As Long)
Dim iniTime As Long
iniTime = timeGetTime
Do
DoEvents
Loop Until (timeGetTime - iniTime) > tm
End Sub
Saludos Ruri
