Envoi de mail en double voir en triple ou plus

Question

Bonjour, Je suis novice dans le domaine, donc j'essaie de me dépatouiller comme je peux, d’où ma question sur le site. Je vous explique mon soucis, J'ai mis en place un vbs qui permet de récupérer un certains nombres d'informations lors de l'ouverture d'une session via GPO, récupérer ensuite un fichier créer par un autre processus et transmettre le tout par mail. jusqu’à la tout se passe bien, sauf que des fois je reçois le même mail en double, voir même en triple ou plus, et cela est assez gênant. J''espère avoir été claire, et espère que vous pouvez m'apporter une solution a mon problème. ci-dessous le vbs en question Set objEmail = CreateObject("CDO.Message")'--------------------Configuration Reseau------------------------ set wshnetwork=wscript.createobject("wscript.network") strComputer = "." Set objWMIService = GetObject("winmgmts:\"& strComputer & " oot\cimv2") Set colAdapters = objWMIService.ExecQuery _ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True") n = 1 For Each objAdapter in colAdapters '--------------------------INFO système d'exploitation--------------------------- 'strComputer = "."Set objWMIService = GetObject("winmgmts:\"& strComputer & " oot\cimv2")Set colItems = objWMIService.ExecQuery _("SELECT * FROM Win32_OperatingSystem")For Each objItem in colItems'--------------------------INFO Computer Systeme----------------------------'strComputer = "."Set objWMIService = GetObject("winmgmts:\" & strComputer & " oot\cimv2")Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)For Each wObjItem in colItems'--------------------------INFO ECRAN----------------------------'strComputer = "."Set objWMIService = GetObject("winmgmts:\" & strComputer & " oot\cimv2")Set colItems = objWMIService.ExecQuery("Select * from Win32_DesktopMonitor",,48)For Each wDesktopObjItem in colItems'--------------------------INFO Processeur----------------------------'strComputer = "."Set objWMIService = GetObject("winmgmts:\" & strComputer & " oot\cimv2")Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor",,48)For Each wProcessorObjItem in colItems'--------------------------INFO MotherBoard----------------------------Set objWMIService = GetObject("winmgmts:\" & strComputer & " oot\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_BaseBoard",,48) For Each wMotherBoardobjItem in colItems '--------------------------INFO Graphique Carte----------------------------'strComputer = "."Set objWMIService = GetObject("winmgmts:\" & strComputer & " oot\cimv2")Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController",,48)For Each wVideoObjItem in colItems '--------------------------FIN --------------------------- 'msgbox "Domaine : " &wshnetwork.userdomain & vbcr & vbcr &"Nom de l'ordinateur: " &wshnetwork.computername & vbcr & vbcr &"Utilisateur Connecté: " &wshnetwork.username & vbcr & vbcr &"Adresse MAC: " & objAdapter.MACAddress & vbcr& vbcr & "Adresse IP: " & objAdapter.IPAddress(i)'--------------------IP PUBLIC------------------------'Option ExplicitDim http : Set http = CreateObject( "MSXML2.ServerXmlHttp" )http.Open "GET", "http://icanhazip.com", Falsehttp.Send'Wscript.Echo http.responseText 'or do whatever you want with it'Set http = Nothing'--------------------Var d'environnement------------------------Set wshShell = WScript.CreateObject( "WScript.Shell" )strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )Set wshShell = WScript.CreateObject( "WScript.Shell" )strPathDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )Set wshShell = WScript.CreateObject( "WScript.Shell" )strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )Set wshShell = WScript.CreateObject( "WScript.Shell" )strComputerDomain = wshShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).ExecQuery _ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE") strYear = Year(date)strDay = Day(date)strMonth = Month(date)strSrv = "\srv\log\"EmailSubject = "[IP: "& objAdapter.IPAddress(i) &"] - Ouverture de session par : " & strUserName & " sur le poste " & strComputerName & ""EmailBody = "Bonjour, "& vbNewLine &" "& vbNewLine & _" Une ouverture de session a été detecté sur le poste " & strComputerName & ", avec le login "& strUserName &" le "& Date &" à "& Time &". "& vbNewLine &" "& vbNewLine & _" ----- informations Reseau -----"& vbNewLine &" "& vbNewLine & _" Domaine : "& strComputerDomain &" "& vbNewLine & _" IP Public : "& http.responseText & _" IP Prive : "& objAdapter.IPAddress(i) &" "& vbNewLine & _" DHCPServer : "& objAdapter.DHCPServer &" "& vbNewLine & _" Date D'expiration du Bail Dhcp : "& objAdapter.DHCPLeaseExpires &" "& vbNewLine & _" DnsDomain : "& objAdapter.DNSDomain &" "& vbNewLine & _" Adresse Mac : "& objAdapter.MACAddress &" "& vbNewLine &" "& vbNewLine & _" ----- informations Systeme Software -----"& vbNewLine &" "& vbNewLine & _" Systeme d'exploitation : "& objItem.Caption &" "& vbNewLine & _" Editeur : "& objItem.Manufacturer &" "& vbNewLine & _" Version : "& objItem.Version &" "& vbNewLine & _" Service pack : "& objItem.CSDVersion &" "& vbNewLine & _" Architecture : "& objItem.OSArchitecture &" "& vbNewLine & _" GUID : "& objItem.SerialNumber &" "& vbNewLine & _" Langue: "& objItem.OSLanguage &" "& vbNewLine & _" LastBoot : "& objItem.LastBootUpTime &" "& vbNewLine &" "& vbNewLine & _" ----- informations Systeme Hardware -----"& vbNewLine &" "& vbNewLine & _" Model : "& wObjItem.Manufacturer &" "& wObjItem.Model &" "& vbNewLine & _" Carte Mere: "& wMotherBoardobjItem.Manufacturer &" "& wMotherBoardobjItem.Product &" "& wObjItem.Model &" "& vbNewLine & _" SystemType : "& wObjItem.SystemType &" "& vbNewLine & _" Processeur : "& wProcessorObjItem.Name &" "& vbNewLine & _" Model : "& wProcessorObjItem.Manufacturer &" "& vbNewLine & _" Socket : "& wProcessorObjItem.SocketDesignation &" "& vbNewLine & _" Carte graphique : "& wVideoObjItem.Name &" "& vbNewLine &" "& vbNewLine & _" Vous trouverez le fichier de log dans :"& strSrv &" "& strYear&"\"& strDay& "-"& strMonth& "\"& strUserName &"\ ."& vbNewLine &" "& vbNewLine & _" Votre administrateur Systeme." EmailFrom = "mail@mail.com"EmailFromName = "Admin"EmailTo = "mail@mail.com"SMTPServer = "smtp.maill.com"SMTPLogon = "mail@mail.com"SMTPPassword = "Pass"SMTPSSL = TrueSMTPPort = 465cdoSendUsingPickup = 1 'Send message using local SMTP service pickup directory.cdoSendUsingPort = 2 'Send the message using SMTP over TCP/IP networking.cdoAnonymous = 0 ' No authenticationcdoBasic = 1 ' BASIC clear text authenticationcdoNTLM = 2 ' NTLM, Microsoft proprietary authentication'------------------Corps du message-----------------------------objEmail.From = """" & EmailFromName & """ <" & EmailFrom & ">"objEmail.To = EmailToobjEmail.Subject = EmailSubjectobjEmail.Textbody = EmailBody'-------------- Envoi de pièce jointe ---------------------------objEmail.AddAttachment ""&strPathDir&"\Working\Connexion_"&strComputerName& "_"& strUserName & "_C.log"' -------------------------- Configuration Serveur Mail---------------------------------------objEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPortobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServerobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/sendusername") = SMTPLogonobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SMTPPasswordobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPortobjEmail.Configuration.Fields _("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SMTPSSLobjEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60objEmail.Configuration.Fields.UpdateobjEmail.Send'-------------MsgBox de test d'envoi de mail----------------'If Err.Number <> 0 Then ' MsgBox Err.Description,16,"Error Sending Mail"'Else ' MsgBox "Mail was successfully sent !",64,"Information"'End If'set MonFic=nothing next next next next next nextNEXT Merci d'avance

jordane45 · Answer

Bonjour 



L'envoie du mail.... se trouve dans des boucles....
a mon avis ....commence par ça.

cs_JMO · Answer

Bonsoir,

Comme le dit Jordane (que je salue), toutes ces boucles sont inutiles.
 
Exemple en simplifiant le script présenté :
 
Option Explicit

' Déclaration variables

' variables objets
Dim wshnetwork, objWMIService, wshShell

' variables collections
Dim colAdapters, colItems
Dim objAdapter, objItem

' variables string
Dim strComputer, strUserName, strPathDir, strComputerName, strComputerDomain

' Initialisation variables
strComputer = "."

Set wshShell = WScript.CreateObject("WScript.Shell")
strUserName = wshShell.ExpandEnvironmentStrings("%USERNAME%")
strPathDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
strComputerName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
strComputerDomain = wshShell.ExpandEnvironmentStrings("%USERDOMAIN%")
                       
MsgBox "strUserName :" & vbTab & vbTab & strUserName & vbCrLf & _ 
       "strPathDir :" & vbTab & vbTab & strPathDir & vbCrLf & _ 
       "strComputerName :" & vbTab & vbTab & strComputerName & vbCrLf & _ 
       "strComputerDomain :" & vbTab & strComputerDomain

Set objWMIService = GetObject("winmgmts:\"&  strComputer & "oot\cimv2")
Set colAdapters = objWMIService.ExecQuery _
                  ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

For Each objAdapter in colAdapters
   '--------------------------INFO système d'exploitation---------------------------
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
   For Each objItem in colItems
       MsgBox "Machine Name:" & vbTab & vbTab & objItem.CSName & vbCrLf & _ 
              "Manufacturer:" & vbTab & vbTab & objItem.Manufacturer & VbCrLf & _ 
              "Systeme d'exploitation :" & vbTab & objItem.Caption & vbCrLf & _ 
              "Editeur :" & vbTab & vbTab & vbTab & objItem.Manufacturer & vbCrLf & _ 
              "Version :" & vbTab & vbTab & vbTab & objItem.Version & vbCrLf & _ 
              "Service pack :" & vbTab & vbTab & objItem.CSDVersion & vbCrLf &_ 
              "Architecture :" & vbTab & vbTab & objItem.OSArchitecture & vbCrLf & _ 
              "GUID :" & vbTab & vbTab & vbTab & objItem.SerialNumber & vbCrLf & _ 
              "Langue :" & vbTab & vbTab & vbTab & objItem.OSLanguage & vbCrLf & _ 
              "LastBoot :" & vbTab & vbTab & objItem.LastBootUpTime,,"objAdapter"
      
      'Exit For
              
    Next
Next
Set colAdapters = Nothing
Set objWMIService = Nothing
Set wshnetwork = Nothing
Set wshShell = Nothing 
Set colItems = NothingPour test, il suffit de lancer cet exemple, puis de le relancer en enlevant le ' devant Exit For.

Beaucoup d'incohérences dans le script initial, plusieurs mêmes propriétés sont accessibles par différentes classes.
Mettre l'envoi du mail dans une fonction. 

jean-marc

laboon91 · Answer

Bonjour, 

Merci d'avoir pris le temps de me lire et pour vos réponses, en effet en regardant bien mon script je me suis rendu compte qu'il y avait plusieurs boucle, je vais de ce pas appliqué vos recommandation et vous ferai un retour si cela résout mon problème.

dans tout les cas un grand merci a vous.

Hackoo · Answer

Salut ! Essayez d'organiser votre script par des procédures et des fonctions comme ceci : Option Explicit ' Déclaration variables ' variables objets Dim wshnetwork, objWMIService, wshShell ' variables collections Dim colAdapters, colItems Dim objAdapter, objItem ' variables string Dim strComputer,fso, strUserName, strPathDir, strComputerName Dim TxtFile,MailLog,MsgHTML, strComputerDomain,Msg,Title,arrFiles,sFile ' Initialisation variables Title = "Envoi de mail Infos Poste" strComputer = "." Set wshShell = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") strUserName = wshShell.ExpandEnvironmentStrings("%USERNAME%") strPathDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" ) strComputerName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%") strComputerDomain = wshShell.ExpandEnvironmentStrings("%USERDOMAIN%") TxtFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt" MailLog = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log" arrFiles = Array(TxtFile,MailLog) For each sFile in arrFiles if fso.FileExists(sFile) Then 'Si le fichier sFile existe fso.DeleteFile sFile 'alors on le supprime end If Next Msg = "" Msg = Msg & "strUserName :" & vbTab & vbTab & strUserName & vbCrLf & _ "strPathDir :" & vbTab & vbTab & strPathDir & vbCrLf & _ "strComputerName :" & vbTab & vbTab & strComputerName & vbCrLf & _ "strComputerDomain :" & vbTab & strComputerDomain & vbCrLf & vbCrLf Set objWMIService = GetObject("winmgmts:\"& strComputer & " oot\cimv2") Set colAdapters = objWMIService.ExecQuery _ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True") For Each objAdapter in colAdapters '--------------------------INFO système d'exploitation--------------------------- Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem") For Each objItem in colItems Msg = Msg & "Machine Name:" & vbTab & vbTab & objItem.CSName & vbCrLf & _ "Manufacturer:" & vbTab & vbTab & objItem.Manufacturer & VbCrLf & _ "Systeme d'exploitation :" & vbTab & objItem.Caption & vbCrLf & _ "Editeur :" & vbTab & vbTab & vbTab & objItem.Manufacturer & vbCrLf & _ "Version :" & vbTab & vbTab & vbTab & objItem.Version & vbCrLf & _ "Service pack :" & vbTab & vbTab & objItem.CSDVersion & vbCrLf &_ "Architecture :" & vbTab & vbTab & objItem.OSArchitecture & vbCrLf & _ "GUID :" & vbTab & vbTab & vbTab & objItem.SerialNumber & vbCrLf & _ "Langue :" & vbTab & vbTab & vbTab & objItem.OSLanguage & vbCrLf & _ "LastBoot :" & vbTab & vbTab & vbTab & WMIDateStringToDate(objItem.LastBootUpTime) Next Next Set colAdapters = Nothing Set objWMIService = Nothing Set wshnetwork = Nothing Set wshShell = Nothing Set colItems = Nothing '*************************************************************************************** Function WMIDateStringToDate(dtmDate) WMIDateStringToDate = CDate(Mid(dtmDate, 7, 2) & "/" & _ Mid(dtmDate, 5, 2) & "/" & Left(dtmDate, 4) _ & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2)) End Function '*************************************************************************************** Function EMail( myFrom, myTo, mySubject, myTextBody, myHTMLBody, myAttachment, mySMTPServer, mySMTPPort ) ' This function sends an e-mail message using CDOSYS ' ' Arguments: ' myFrom = Sender's e-mail address ("John Doe " or "jdoe@mydomain.org") ' myTo = Receiver's e-mail address ("John Doe " or "jdoe@mydomain.org") ' mySubject = Message subject (optional) ' myTextBody = Actual message (text only, optional) ' myHTMLBody = Actual message (HTML, optional) ' myAttachment = Attachment as fully qualified file name, either string or array of strings (optional) ' mySMTPServer = SMTP server (IP address or host name) ' mySMTPPort = SMTP server port (optional, default 25) ' ' Returns: ' status message ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com ' Standard housekeeping Dim i, objEmail ' Use custom error handling On Error Resume Next ' Create an e-mail message object Set objEmail = CreateObject( "CDO.Message" ) ' Fill in the field values With objEmail .From = myFrom .To = myTo ' Other options you might want to add: ' .Cc = ... ' .Bcc = ... .Subject = mySubject .TextBody = myTextBody .HTMLBody = myHTMLBody If IsArray( myAttachment ) Then For i = 0 To UBound( myAttachment ) .AddAttachment Replace( myAttachment( i ), "", "\" ),"","" Next ElseIf myAttachment <> "" Then .AddAttachment Replace( myAttachment, "", "\" ),"","" End If If mySMTPPort = "" Then mySMTPPort = 25 End If With .Configuration.Fields .Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ) = 2 .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ) = mySMTPServer .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ) = mySMTPPort .Update End With ' Send the message .Send End With ' Return status message If Err Then EMail = "ERROR " & Err.Number & ": " & Err.Description Err.Clear Else EMail = Now & " ==> Message sent ok !" End If ' Release the e-mail message object Set objEmail = Nothing ' Restore default error handling On Error Goto 0 End Function '*************************************************************************************** Function GMail( myFrom, myTo, mySubject, myTextBody, myHTMLBody, myAttachment ,myLogin , myPassword) Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory. Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network). Const cdoAnonymous = 0 'Do not authenticate Const cdoBasic = 1 'basic (clear-text) authentication Const cdoNTLM = 2 'NTLM Dim i, objEmail ' Use custom error handling On Error Resume Next ' Create an e-mail message object Set objEmail = CreateObject( "CDO.Message" ) ' Fill in the field values With objEmail .From = myFrom .To = myTo ' Other options you might want to add: ' .Cc = ... ' .Bcc = ... .Subject = mySubject .TextBody = myTextBody .HTMLBody = myHTMLBody If IsArray( myAttachment ) Then For i = 0 To UBound( myAttachment ) .AddAttachment Replace( myAttachment( i ), "", "\" ),"","" Next ElseIf myAttachment <> "" Then .AddAttachment Replace( myAttachment, "", "\" ),"","" End If With .Configuration.Fields .Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ) = 2 .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ) = "smtp.gmail.com" .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ) = 465 .Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ) = cdoBasic .Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ) = myLogin .Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ) = myPassword .Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ) = True .Item ( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ) = 60 .Update End With ' Send the message .Send End With ' Return status message If Err Then GMail = "ERROR " & Err.Number & ": " & Err.Description Err.Clear Else GMail = Now & " ==> Message sent ok !" End If ' Release the e-mail message object Set objEmail = Nothing ' Restore default error handling On Error Goto 0 End Function '*************************************************************************************** Sub WriteLog(strText,File) Dim fso,ts Const ForAppending = 8 Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(File,ForAppending, True) ts.WriteLine strText ts.Close End Sub '*************************************************************************************** Function GetPublicIP() Dim http : Set http = CreateObject( "MSXML2.ServerXmlHttp" ) http.Open "GET", "http://icanhazip.com", False http.Send GetPublicIP = http.responseText Set http = Nothing End Function '*************************************************************************************** MsgBox Msg,vbInformation,Title Call WriteLog(Msg,TxtFile) MsgHTML = Replace(Msg,vbCrLf,"
") Dim arrAttach : arrAttach = Array(TxtFile) 'EMail( myFrom, myTo, mySubject, myTextBody, myHTMLBody, myAttachment, mySMTPServer, mySMTPPort ) Call WriteLog( EMail( "User ","User ",GetPublicIP(),"Message TEXT!",MsgHTML,arrAttach,"smtp.orange.fr",25 ),MailLog ) 'GMail( myFrom, myTo, mySubject, myTextBody, myHTMLBody, myAttachment ,myLogin , myPassword) 'Call WriteLog(GMail( "user@gmail.com","user2@gmail.com",GetPublicIP(),"Message TEXT!",MsgHTML,arrAttach,"VotreLoginGmail","VotrepassGmail"),MailLog)

Envoi de mail en double voir en triple ou plus

4 réponses

Votre réponse

Discussions similaires