Robocopy email en vbs

Robocopy email en vbs - VB/VBA/VBS - Programmation

Marsh Posté le 25-04-2019 à 08:12:35    

Bonjour à toute et a tous,  
Voila je dois crée un programme en vbs pour une robocopie ensuite une copie de résultat dans un fichier texte et un renvoie du fichier par mail  
j'ai effectuer un fichier vss et un fichier bat  
le problème c'est pour les adresse cdo qui sont invalide je ne voit pas de solution j'ai beau chercher je vous met ci joint mes programme  
je voudrais également utilisé mon propre serveur smtp.
 
Programme vbs :
 
'robocopy.vbs
 
Dim txtSMTPServer, txtTo, txtFrom, txtSubject, txtBody
Dim txtLog, strValue, iTotal, iPos, strText
 
txtSMTPServer = "smtp.adresse.fr"           'SMTP server
txtTo = "exemple@gmail.com"                    'To Address
txtFrom = "exemple@gmail.com"                     'From Address
txtSubject = "robocopy"            'Subjet du mail
txtLog = "C:\Users\user\Desktop\vbs\TestSauvegarde\log.txt" 'chemin du fichier de log de robocopy
 
'Récupérer le contenu du fichier
FileContents = GetFile(txtLog)
 
'-- Cycle thru the log file to find errors --
strText = FileContents
iPos = 1
Do While iPos <= Len(strText)
   If InStr(iPos, UCase(strText), "0X00000" ) > 0 Then
       iTotal = iTotal + 1
            iPos = InStr(iPos, UCase(strText), "0X00000" )_
            + Len("0X00000" )
        Else
            Exit Do
end If
Loop
 
'-- --
 
If iTotal > 0 Then
   strErrors = 1
Else
   strErrors = 0
End If
 
'Sortie significative en cas d'erreur de copie
If strErrors = 1 Then
   txtBody = "La sauvegarde a détecté " & iTotal & " fichiers " &_
   "qui n'ont pas pu être sauvegardés. Voir le fichier log ci-joint. " & vbcrlf & "" &_  
   "Il est possible que ces fichiers soient liés à une application restée en cours d'exécution."
Else
   txtBody = "La sauvegarde ROBOCOPY a réussie. Pas d'erreur trouvée dans le fichier log. "  &_
   "No errors seem to be present in this robocopy log. See attached file."
End If  
 
 
'-- Envoie d'Email --
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
cdoSendUsingPort = 2
cdoSMTPServer = "https://schemas.microsoft.com/cdo/configuration/smtpserver"
 
'// Créer les connexions CDO.
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message" )
Set iConf = CreateObject("CDO.Configuration" )
Set Flds = iConf.Fields
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = txtSMTPServer
.Update
End With
 
'// Mettre les propriétés du message.
With iMsg
Set .Configuration = iConf
.To = txtTo
.From = txtFrom
.Subject = txtSubject
.TextBody = txtBody
End With
if txtlog <> "" then iMsg.AddAttachment txtLog
'// Send the message.
iMsg.Send ' send the message.
'-- Fonction de lecture du fichier --
function GetFile(txtLog)
  If txtLog<>"" Then
    Dim FS, FileStream
    Set FS = CreateObject("Scripting.FileSystemObject" )
      on error resume Next
      Set FileStream = FS.OpenTextFile(txtLog)
      GetFile = FileStream.ReadAll
  End If
End Function

 
programme bat
 
@Echo off
SET LOG="C:Utilisateurs\user\Bureau\vbs\TestSauvegarde\log.txt"
SET DEST="C:\Utilisateurs\user\Bureau\vbs\destination"
SET SOURCE="C:\Utilisateurs\user\Bureau\vbs\source"
c:
robocopy %SOURCE% %DEST% /E /Z /SEC /MIR /LOG:%LOG% /NP /R:1 /W:2
cscript "C:\Users\user\Desktop\vbs\robocopie.vbs"
pause
dir c: \ windows
pause

 
C'est la première fois que j'utilise se langage donc si il y a des erreurs merci de me le signaler. mais je pense que sa doit fonctionner j'ai utiliser des programme déjà effectuer afin de composer le mien  
Merci d'avance pour votre aide

Reply

Marsh Posté le 25-04-2019 à 08:12:35   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed