traitement d'erreur

Question

Bonjour,
Est ce que kk1 pourrait m'&#233;clairer sur un probl&#232;me de boucle. En fait, dans le programme, on a affaire &#224; un traitement d'erreur de fichiers .eml. Le programme parcours des r&#233;pertoires r&#233;cup&#232;re des codes lot et op&#233;ration et affiche le r&#233;sultat dans un fichier .txt. S'il ya des erreurs il les d&#233;tecte et affiche le tout ds un fichier error.log. 
Moi je voudrais avoir le nombre d'erreurs correspondant &#224; chaque op&#233;ration dans chaque r&#233;pertoire; et je n'arrive pas &#224; faire une bonne boucle.
Merci de me r&#233;pondre.

Annick

cs_Jack · Answer

Question pas assez pr&#233;cise.
Quand tu parles d'erreur, ce sont des erreurs de quoi ? du programme ? --> Voir "On Error Goto monLabel" dans l'aide de VB6

Vala
Jack
NB : Je ne r&#233;pondrai pas aux messages priv&#233;s 

Le savoir est la seule mati&#232;re qui s'accroit quand on la partage. (Socrate)

faidoa · Answer

Merci de me répondre Jack. Je vais essayer d'ête plus claire. En fait c'est un programme qui doit nettoyer une base de donnée client et qui fonctionne en mode console(il faut entre autre l'automatiser, c'est aussi un autre pb et je souhaiterais savoir comment?). Pour des retours de mails, il doit savoir la cause du retour. Mais mon petit problème c'est que je veux qu'il affiche le nombre total d'erreur survenue pour chaque opération (sClientOp). Les sous dossiers correspondants aux clients contiennent des fichiers .msg, lesquels comprennent les numéros d'opérations. Mais ces fichiers .msg ne sont parfois pas en ordre ds le dossier client. Je veux que pour une opération 8 du client X, il affiche: Client:X Op:8 Nbre erreur:12 ************* Op:10 Nbre erreur:5 *************** Op:15 Nbre erreur:20 ************** ************** Client:Y Op:5 Nbre erreur:10 ************* Op:7 Nbre erreur:15 **************** etc.......... En fait voici ce que fait le programme: Option Explicit Option Base 0 Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleOutput As Long, dwMode As Long) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long Private Const STD_INPUT_HANDLE = -10& Private Const STD_OUTPUT_HANDLE = -11& Private Const ENABLE_ECHO_INPUT = &H4 Private Type COORD x As Integer y As Integer End Type Private Type SMALL_RECT Left As Integer Top As Integer Right As Integer Bottom As Integer End Type Private Type CONSOLE_SCREEN_BUFFER_INFO dwSize As COORD dwCursorPosition As COORD wAttributes As Integer srWindow As SMALL_RECT dwMaximumWindowSize As COORD End Type Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As Long, lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long Private Const FOREGROUND_BLUE = &H1 ' text color contains blue. Private Const FOREGROUND_GREEN = &H2 ' text color contains green. Private Const FOREGROUND_INTENSITY = &H8 ' text color is intensified. Private Const FOREGROUND_RED = &H4 ' text color contains red. Private hOutput As Long Private hInput As Long Private Const SYNCHRONIZE = &H100000 Private Const INFINITE = &HFFFFFFFF Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long ' Application declarations Private Const EM_LICENSE = "Louise Priest (Single Developer)/0010630410721500AB30" Dim oCnBounce As ADODB.Connection, oRsBounce As ADODB.Recordset Dim oFSO As Scripting.FileSystemObject Sub Main() Dim scrbuf As CONSOLE_SCREEN_BUFFER_INFO hInput = GetStdHandle(STD_INPUT_HANDLE) If SetConsoleMode(hInput, ENABLE_ECHO_INPUT) <> 0 Then Err.Raise -1, "ip3bounce", "No input console" hOutput = GetStdHandle(STD_OUTPUT_HANDLE) GetConsoleScreenBufferInfo hOutput, scrbuf Dim sCommand As String sCommand = Command() If sCommand "-?" Or sCommand "/?" Or sCommand = "/help" Or sCommand = "-help" Then WriteToConsole "IP3BOUNCE [-s chemin] [-d nom_de_fichier] [-y]" & vbNewLine & vbNewLine WriteToConsole " -s Chemin vers les fichiers sources." & vbNewLine WriteToConsole " -d Nom du fichier d'export." & vbNewLine WriteToConsole " -m Chemin ou deplacer les fichiers en traitement." & vbNewLine WriteToConsole " -yd Supprime les fichiers sources en traitement." & vbNewLine WriteToConsole " -ym Deplace les fichiers sources en traitement." & vbNewLine WriteToConsole " -i Mode interatif." & vbNewLine WriteToConsole " -l Taille maximum par fichier a traiter." & vbNewLine End Else WriteToConsole vbNewLine & "I-Pousse 3.0 Bounce Agent FS [version 3.0.0000]" & vbNewLine WriteToConsole "(C) Copyright 2004 Agence I-Puzzle." & vbNewLine WriteToConsole vbNewLine WriteToConsole vbNewLine End If Dim sSourceFolder As String, sDestinationFile As String, sNomFichier As String, sDateGeneration As String, sMoveFolder As String, tMoveFolder As String, hMoveFolder As String, lMaxFileSize As Long Dim bMoveFiles As Boolean, bDeleteFiles As Boolean, bInteractiveMode As Boolean sSourceFolder = "" sDestinationFile = "" sMoveFolder = "" lMaxFileSize = 131072 bDeleteFiles = False bInteractiveMode = False Dim oCommandCol As Collection Dim oArgvParser As New ArgvParser With oArgvParser Set oCommandCol = .CommandToStringArray(sCommand) Dim lArgIndex As Long For lArgIndex = 1 To oCommandCol.Count If oCommandCol(lArgIndex) = "-s" And lArgIndex < oCommandCol.Count Then sSourceFolder = oCommandCol(lArgIndex + 1) WriteToConsole "Source folder is [" & sSourceFolder & "]" & vbNewLine End If If oCommandCol(lArgIndex) = "-m" And lArgIndex < oCommandCol.Count Then sMoveFolder = oCommandCol(lArgIndex + 1) WriteToConsole "Move folder is [" & sMoveFolder & "]" & vbNewLine End If If oCommandCol(lArgIndex) = "-d" And lArgIndex < oCommandCol.Count Then sDestinationFile = oCommandCol(lArgIndex + 1) WriteToConsole "Destination file is [" & sDestinationFile & "]" & vbNewLine End If If oCommandCol(lArgIndex) = "-l" And lArgIndex < oCommandCol.Count Then lMaxFileSize = CLng(oCommandCol(lArgIndex + 1)) * 1024 WriteToConsole "Max file size to process is [" & lMaxFileSize & "]" & vbNewLine End If If oCommandCol(lArgIndex) = "-yd" Then bDeleteFiles = True End If If oCommandCol(lArgIndex) = "-ym" Then bMoveFiles = True End If If oCommandCol(lArgIndex) = "-i" Then bInteractiveMode = True End If Next End With Set oArgvParser = Nothing Call BounceSignature_Load Set oFSO = New Scripting.FileSystemObject Dim oFolder As Folder, oOpFolder As Folder, oClFolder As Folder, sFolder As Folder, oFile As File, oTextStream As TextStream, oDestinationStream As TextStream Dim oLogStream As TextStream, oErrorStream As TextStream, oUnknownStream As TextStream, oUnknowntStream As TextStream Dim sExtension As String, sbody As String, sBounceType As String, sBounceMessage As String, aTemp As Variant Dim sClientId As String Dim sClientOp As String If sSourceFolder "" Then sSourceFolder CurDir 'If sDestinationFile "" Then sDestinationFile "I_POUSSE_BOUNCE_FS_" & Format(Now(), "YYYYMMDDHHNNSS" & ".txt") If sDestinationFile "" Then sDestinationFile "[" & sClientId & "_" & sClientOp & "_" & Format(Now(), "YYYYMMDDHHNNSS" & ".txt") & "]" If sNomFichier "" Then sNomFichier "[ Nom Fichier :" & sDestinationFile & "]" & vbNewLine If sDateGeneration "" Then sDateGeneration "[ Date génération :" & Format(Now(), "YYYY_MM_DD HH:NN:SS") & "]" & vbNewLine If sMoveFolder <> "" Then If oFSO.FolderExists(sMoveFolder) = False Then oFSO.CreateFolder sMoveFolder End If If oFSO.FolderExists(sSourceFolder) = True Then Set oFolder = oFSO.GetFolder(sSourceFolder) Set oDestinationStream = oFSO.CreateTextFile(sDestinationFile, False) oDestinationStream.WriteLine ("Client" & vbTab & vbTab & "ClientOp" & vbTab & vbTab & "lot" & vbTab & vbTab & "Erreur" & vbTab & vbTab & "Type_Erreur") & vbNewLine If oFSO.FileExists(App.Path & "\ip3bounce.log") = True Then Set oLogStream = oFSO.GetFile(App.Path & "\ip3bounce.log").OpenAsTextStream(ForAppending) Else Set oLogStream = oFSO.CreateTextFile(App.Path & "\ip3bounce.log", False) End If If oFSO.FileExists(App.Path & "\ip3bounce.error.log") = True Then Set oErrorStream = oFSO.GetFile(App.Path & "\ip3bounce.error.log").OpenAsTextStream(ForAppending) Else Set oErrorStream = oFSO.CreateTextFile(App.Path & "\ip3bounce.error.log", False) End If If oFSO.FileExists(App.Path & "\ip3bounce.unknown.log") = True Then Set oUnknownStream = oFSO.GetFile(App.Path & "\ip3bounce.unknown.log").OpenAsTextStream(ForAppending) Else Set oUnknownStream = oFSO.CreateTextFile(App.Path & "\ip3bounce.unknown.log", False) End If oLogStream.Write vbNewLine & vbNewLine oLogStream.WriteLine App.ProductName & " [" & App.Major & "." & Format(App.Minor, "0") & "." & Format(App.Revision, "0000") & "]" oLogStream.WriteLine Now() & " - Processing start for source folder [" & sSourceFolder & "] to destination file [" & sDestinationFile & "]" 'rajouter dim tFilesMoved, lClientOp Dim lFilesCount As Long, lFilesDeleted As Long, lMax As Long, lOpCount As Long, lFilesMoved As Long, tFilesMoved As Long, hFilesMoved As Long, lErrorsCount As Long, lFilesProcessed As Long lFilesCount = 0 lMax = 0 lFilesDeleted = 0 lFilesMoved = 0 tFilesMoved = 0 lErrorsCount = 0 lFilesProcessed = 0 lOpCount = 0 Dim aTempOp As Variant Dim aTempCl As Variant Dim sOp As String Dim c As Variant Dim o As Variant Dim i As Variant Dim j As Variant 'If oFSO.FolderExists(oFolder.SubFolders) = False Then 'WriteToConsole vbNewLine & "pas de sous répertoire" & vbNewLine 'Else On Error GoTo f For Each sFolder In oFolder.SubFolders oDestinationStream.WriteLine "Client :" & sFolder.Name Exit Sub f: On Error Resume Next 'pour chaque fichier inclu dans ce sous répertoire 'For Each oFile In oFolder.Files For Each oFile In sFolder.Files sExtension = UCase(Right(oFile.Name, 4)) If (sExtension ".MSG" Or sExtension ".EML") Then lFilesCount = lFilesCount + 1 If CLng(oFile.Size) > lMaxFileSize Then WriteToConsole "Passed file due to maximum size limit [" & oFile.Name & "]." lMax = lMax + 1 Else Set oTextStream = oFile.OpenAsTextStream(ForReading) sbody = oTextStream.ReadAll sClientId = "" sBounceType = BounceSignature_Identify(sbody) oTextStream.Close Set oTextStream = Nothing sClientOp = "" sClientId = XHeader_Identify(sbody, "X-Id_Client:") sClientOp = XHeader_Identify(sbody, "X-Id_Campagne:") 'Ecrire dans le fichier destination, rajouter sClientOp(Id_Op) 'If sDestinationFile "" Then sDestinationFile "[" & sClientId & "_" & sClientOp & "_" & Format(Now(), "YYYYMMDDHHNNSS") & "_" & lFilesCount & "]" & ".txt" 'StrComp(i, j, vbTextCompare) = 1 'Créer un dossier de toutes les opérations et Id clients Set oOpFolder = oFSO.GetFolder(sClientOp) Set oClFolder = oFSO.GetFolder(sClientId) aTempOp = Split(oOpFolder, "vbTab") aTempCl = Split(oClFolder, "vbTab") 'c = aTempCl(0) 'o = aTempCl(c + 1) i = aTempOp(0) j = aTempOp(i + 1) If sBounceType <> "0" Then lFilesProcessed = lFilesProcessed + 1 aTemp = Split(sBounceType, ";") sBounceMessage = Mid(sBounceType, Len(aTemp(0)) + 2) sBounceType = aTemp(0) If sClientId <> "" Then WriteToConsole "Processed file [" & oFile.Name & "] as bounce [" & sBounceType & ";" & sBounceMessage & "]." oDestinationStream.WriteLine (sClientId & vbTab & sClientOp & vbTab & XHeader_Identify(sbody, "X-Id_Lot:") & vbTab & sBounceMessage & vbTab & sBounceType) & vbNewLine 'Else ' oDestinationStream.WriteLine "Client = [" & Mid(sSourceFolder, 4) & "]_(" & c & ")" & vbNewLine ' oDestinationStream.WriteLine "Opération_Id = [" & i & "]" & vbNewLine 'End If Else WriteToConsole "Passed file due to unknown extended header [" & oFile.Name & "] but as bounce [" & sBounceType & ";" & sBounceMessage & "]." oUnknownStream.WriteLine sDestinationFile & vbTab & oFile.Path & vbTab & "unknown_header" oDestinationStream.WriteLine "unknown_Id" & vbTab & "unknown_Op" & vbTab & XHeader_Identify(sbody, "Date:") & vbTab & sBounceMessage & vbTab & sBounceType & vbNewLine If bInteractiveMode Then ShellAndWait "notepad """ & oFile.Path & """", vbNormalFocus End If End If Else WriteToConsole "Passed file due to unknown bounce [" & oFile.Name & "]." oUnknownStream.WriteLine sDestinationFile & vbTab & oFile.Path & vbTab & "unknown_bounce" If bInteractiveMode Then ShellAndWait "notepad """ & oFile.Path & """", vbNormalFocus End If End If 'si non supprimés, non déplacés, non traités If (Not bDeleteFiles And Not bMoveFiles) Or Err Or sClientId "" Or sBounceType "0" Then WriteToConsole " Not moved/deleted." Else If bDeleteFiles Then oFile.Delete True lFilesDeleted = lFilesDeleted + 1 WriteToConsole " Deleted." ElseIf bMoveFiles Then oFile.Move sMoveFolder & "" & oFile.Name lFilesMoved = lFilesMoved + 1 WriteToConsole " Moved." End If End If If Err Then Err.Clear oErrorStream.WriteLine sDestinationFile & vbTab & sClientOp & vbTab & oFile.Path & vbTab & "error" lErrorsCount = lErrorsCount + 1 If i = j Then lOpCount = lOpCount + 1 Else i = j j = aTempOp(i + 1) End If WriteToConsole " An error has occured." If bInteractiveMode Then ShellAndWait "notepad """ & oFile.Path & """", vbNormalFocus End If End If 'End If End If WriteToConsole vbNewLine Set oFile = Nothing End If Next On Error GoTo 0 Next On Error GoTo 0 WriteToConsole "There is " & lFilesProcessed & " processed on " & lFilesCount & " file(s)." & vbNewLine If lFilesDeleted > 0 Then WriteToConsole "There is " & lFilesDeleted & " file(s) deleted." & vbNewLine If lFilesMoved > 0 Then WriteToConsole "There is " & lFilesMoved & " file(s) moved." & vbNewLine If tFilesMoved > 0 Then WriteToConsole "There is " & tFilesMoved & " file(s) moved." & vbNewLine If hFilesMoved > 0 Then WriteToConsole "There is " & hFilesMoved & " file(s) moved." & vbNewLine If lMax > 0 Then WriteToConsole "Il y a " & lMax & " MaxFilesSize." & vbNewLine 'ajouter la notification dans le fichier destination. 'oDestinationStream.WriteLine "There is " & hFilesMoved & " file(s) moved." If lErrorsCount > 0 Then WriteToConsole "--- WARNING !!! There is " & lErrorsCount & " error(s) occured. ---" & vbNewLine WriteToConsole vbNewLine & "File [" & sDestinationFile & "] saved." & vbNewLine oLogStream.WriteLine Now() & " - Processed " & lFilesProcessed & "/" & lFilesCount & ", " & lFilesDeleted & " deleted, " & lFilesMoved & " moved and " & lErrorsCount & " error(s)." oDestinationStream.WriteLine "Il ya :" & lErrorsCount & "erreurs" & vbNewLine If lOpCount > 0 Then oDestinationStream.WriteLine "Nombre d'erreur pour l'opération (" & sClientOp & "):" & lOpCount 'If i <> j Then 'oDestinationStream.WriteLine "==========================================================================" 'oDestinationStream.WriteLine "Client = [" & Mid(sSourceFolder, 4) & "]_(" & sClientId & ")" & vbNewLine 'oDestinationStream.WriteLine "--------------------------------------------------------------------------" 'oDestinationStream.WriteLine "Opération_Id = [" & sClientOp & "]" & vbNewLine 'oDestinationStream.WriteLine sNomFichier 'oDestinationStream.WriteLine sDateGeneration 'oDestinationStream.WriteLine "Nombre d'erreur pour l'opération (" & i & "):" & lErrorsCount 'oDestinationStream.WriteLine "===========================================================================" 'end If Else WriteToConsole vbNewLine & "Source folder [" & sSourceFolder & "] not found." & vbNewLine oLogStream.WriteLine Now() & " - Source folder not found." End If oLogStream.WriteLine Now() & " - Processing end" oUnknownStream.Close Set oUnknownStream = Nothing oErrorStream.Close Set oErrorStream = Nothing oLogStream.Close Set oLogStream = Nothing oDestinationStream.Close Set oDestinationStream = Nothing Set oFSO = Nothing Call BounceSignature_Close End Sub Private Sub BounceSignature_Load() Set oCnBounce = New ADODB.Connection Set oRsBounce = New ADODB.Recordset oCnBounce.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\bounce_signature.mdb;User Id=admin;Password=;" oRsBounce.Open "SELECT * FROM bounce_signature ORDER BY weight DESC", oCnBounce, adOpenStatic, adLockBatchOptimistic End Sub Private Sub BounceSignature_Close() oRsBounce.Close Set oRsBounce = Nothing oCnBounce.Close Set oCnBounce = Nothing End Sub Private Function BounceSignature_Identify(ByVal Body As String) As String BounceSignature_Identify = "0" oRsBounce.MoveFirst Do While Not oRsBounce.EOF If InStr(1, Body, CStr(Trim(oRsBounce("signature"))), vbTextCompare) > 0 Then BounceSignature_Identify = oRsBounce("weight") & ";" & oRsBounce("signature") Exit Do End If oRsBounce.MoveNext Loop End Function Private Function XHeader_Identify(ByVal Body As String, ByVal Header As String) As String XHeader_Identify = "" Dim lPos As Long, lLen As Long lPos = InStr(Body, Header) lLen = Len(Header) If lPos <> 0 Then XHeader_Identify = Trim(Mid(Body, lPos + lLen, InStr(lPos, Body, vbLf) - lPos - lLen - 1)) End If End Function Private Function WriteToConsole(sText As String) As Boolean Dim lWritten As Long If WriteFile(hOutput, ByVal sText, Len(sText), lWritten, ByVal 0) = 0 Then WriteToConsole = False Else WriteToConsole = True End If End Function Private Function ReadFromConsole() As String Dim sBuffer As String * 256 Call ReadConsole(hInput, sBuffer, Len(sBuffer), vbNull, vbNull) ReadFromConsole = Left(sBuffer, InStr(sBuffer, vbNullChar) - 3) End Function Private Sub ShellAndWait(ByVal ProgramName As String, ByVal WindowStyle As VbAppWinStyle) Dim process_id As Long Dim process_handle As Long process_id = Shell(ProgramName, WindowStyle) DoEvents process_handle = OpenProcess(SYNCHRONIZE, 0, process_id) If process_handle <> 0 Then WaitForSingleObject process_handle, INFINITE CloseHandle process_handle End If End Sub 'Private Function ParcourirSousDossier() 'For Each sFolder In oFolder.SubFolders 'End Function Annick

Traitement d'erreur

2 réponses

Discussions similaires