VBS OBJSHELL.RUN NO EJECUTANDO "% COMSPEC% / C PING" & MYOBJ & ">>" & ReportFileName
Pregunta
Se supone que el código ejecuta algunos comandos de ping y tracert a un archivo, luego envíe un correo electrónico al archivo.En su lugar, crea un archivo en blanco.
Intenté redirigir de objshell.exec, pero las ventanas emergentes que aparecen son molestas y roban enfoque;Y quiero que esto funcione periódicamente en el fondo utilizando el Programador de tareas.
La sintaxis generada se ve así (y funciona cuando se pegó a la línea de comando):
%COMSPEC% /c ping speedtest.advance2000.com >>c:\temp\testforteresa2-foo@bar-2014-01-08__10-01.txt
La cadena de comando resultante funciona cuando se pegó en una ventana CMD> pero las pruebas en Excel y en la VBS ejecutadas producen un archivo en blanco ...
No le importaría tener un estado de espera para verificar el correo electrónico para que se envíe para que pueda eliminar el archivo TXT.Lo resolverá más tarde :)
'On Error Resume Next
Const ForReading = 1
Const ForAppending = 8
'PingSpeedTest
Sub PingSpeedTest()
Dim GetUserLoginID ''As String
Set objfso = CreateObject("Scripting.FileSystemObject")
Dim WSHNetwork
Set WSHNetwork = CreateObject("WScript.Network")
GetUserLoginID = CStr(WSHNetwork.UserName)
getuserdomain = CStr(WSHNetwork.UserDomain)
'''''''''''REPORT NAME''''''''''''''''''''''''''''''
ReportFileNAme = "c:\temp\testforteresa2-" & GetUserLoginID & "@" & getuserdomain & "-" & _
DatePart("yyyy", Now) & "-" & _
Right("0" & DatePart("m", Now), 2) & "-" & _
Right("0" & DatePart("d", Now), 2) & "__" & _
Right("0" & DatePart("h", Now), 2) & "-" & _
Right("0" & DatePart("m", Now), 2) & ".txt"
On Error Resume Next
objfso.DeleteFile (ReportFileNAme)
On Error GoTo 0
Set reportfile = objfso.OpenTextFile(ReportFileNAme, ForAppending, True)
Set objShell = CreateObject("WScript.Shell")
Set List = CreateObject("System.Collections.ArrayList")
List.Add "speedtest.advance2000.com"
List.Add "myphone.advance2000.com"
List.Add "vdesk.advance2000.com"
'''
For Each MyObj In List
MyCmd = "%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme '''<<< Should work- creates correct syntax but no output
objShell.Run MyCmd, 3, True
MyCmd = "%COMSPEC% /c tracert " & MyObj & " >>" & ReportFileNAme
objShell.Run MyCmd, 3, True
Next ''MyObj
Dim olLook ''As Object 'Start MS Outlook
Dim olNewEmail ''As MailItem ' Object 'New email in Outlook
Dim strContactEmail ''As String 'Contact email address
Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.createitem(0)
strEmailSubject = "TopSellers.accdb Application"
strEmailText = "PING AND TRACEROUTE RESULTS"
'strContactEmail = GetUserLoginID & "@" & getuserdomain & ".com"
With olNewEmail 'Attach template
.To = "Foo@BAR.com" 'strContactEmail<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'.CC = strCc
.body = strEmailText
.Subject = "RE:PING AND TRACERT RESULTS"
.display
.Attachments.Add (ReportFileNAme)
End With
'objfso.DeleteFile (ReportFileNAme)
End Sub
Solución
su
Set reportfile = objfso.OpenTextFile(ReportFileNAme, ForAppending, True)
Abre el archivo llamado ReportFileName.El .run
"%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme
Luego le pide al sistema operativo que escriba en ese archivo abierto.Trate de omitir la creación de ReportFile.