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

¿Fue útil?

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.

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top