VBS objshell.run n'exécute pas "% ComSpec% / C Ping" & MyObJ & ">>" & SignesDfilename

Question

Le code est censé exécuter quelques commandes de ping et de tracest à un fichier, puis envoyez un courrier électronique au fichier.Au lieu de cela, cela crée un fichier vierge.

J'ai essayé de rediriger de objshell.exec, mais les fenêtres contextuelles qui apparaissent sont gênantes et volerent la mise au point;Et je veux que cela fonctionne périodiquement en arrière-plan à l'aide du planificateur de tâches.

La syntaxe générée ressemble à ceci (et fonctionne lorsque collé à la ligne de commande):

%COMSPEC% /c ping speedtest.advance2000.com >>c:\temp\testforteresa2-foo@bar-2014-01-08__10-01.txt

La chaîne de commande résultante fonctionne lorsqu'elle est collé dans une fenêtre CMD> mais les tests d'Excel et dans les VBS exécutés, il donne un fichier vierge ...

Cela ne vous dérangerait pas d'avoir un état d'attente pour vérifier que le courrier électronique doit être envoyé afin de pouvoir supprimer le fichier TXT.Va comprendre que plus tard :)

'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

Answer 1

votre

Set reportfile = objfso.OpenTextFile(ReportFileNAme, ForAppending, True)

ouvre le fichier nommé reporterfilename.Le .run

"%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme  

demande ensuite au système d'exploitation d'écrire sur ce fichier ouvert.Essayez de sauter la création de fichier de compte.