Je rajoute une petite chose. Le code suivant marche parfaitement, me colle tous aux bons endroits dans le fichier Excel : je passe une chaine de caractères en paramètre. Donc ici, je ne fait pas encore ajouter l'ouverture d'outlook, le traitement ne se fait pas non plus sur le corps du message mais bien sur une chaine (strChaine).
Voici le code, vous pouvez le tester dans un nouveau module sur une feuille vierge. Il faut juste créer un autre classeur nommé "Rapport.xls", j'ai juste mit des titres: A1 -> Date et Heure
B1 -> Type d'accès
C1 -> Source
D1 -> Destination
(Je met en violet une variable que vous devez modifier.)
Option Explicit
Sub EssaiExtractInfo2()
Dim strChaine As String
strChaine = "Mon, 2009-10-26 09:08:54 - Access site - Source:10.120.128.2,WAN - Destination:liveupdate.symantecliveupdate.com,WAN - [Forward] Mon, 2009-10-26 09:10:46 - Access site - Source:10.120.128.2,WAN - Destination:mm.123cmail.fr,WAN - [Forward] Mon, 2009-10-26 09:11:38 - Attempt to access blocked sites - Source:10.120.128.2,LAN - Destination:yahoo.astrocenter.fr/imgmails/picto/fr/90x90tth.gif,WAN Mon, 2009-10-26 09:10:47 - Access site - Source:10.120.128.2,WAN - Destination:ads.leadium.com,WAN - [Forward] Mon, 2009-10-26 09:10:47 - Access site - Source:10.120.128.2,WAN - Destination:wm.wizzms.com,WAN - [Forward] Mon, 2009-10-26 09:11:37 - Access site - Source:10.120.128.2,WAN - Destination:c.astrocenter.fr,WAN - [Forward] Mon, 2009-10-26 09:11:38 - Attempt to access blocked sites - Source:10.120.128.2,LAN - Destination:yahoo.astrocenter.fr/imgmails/bigpicto/fr/300x250_fr2k2.jpg,WAN"
InsertIntoExcel (strChaine)
End Sub
'Procédure permettant le traitement du message, et l'insertion dans le fichier Excel
Sub InsertIntoExcel(ByVal message As String)
Dim myArray() As String, myArrayB() As String, _
myArrayC() As String, myArrayD() As String, _
myArrayE() As String, myArrayF() As String, _
myArrayG() As String, myArrayH() As String
Dim xlApp As Excel.Application
Dim xl_Book As Excel.Workbook
Dim xl_Sheet As Excel.Worksheet
Dim xlApp_Cree As Boolean
Dim xl_Book_Cree As Boolean
Dim cheminFic As String
Dim i As Integer, _
m As Integer, n As Integer, o As Integer, p As Integer
Dim j As Integer, k As Integer, l As Integer
Dim q As Integer
Dim x As Byte, y As Byte
Dim cel As Range, laPlage As Range
'Initialisation des variables
cheminFic = ""
m = 0
n = 0
o = 0
p = 0
'Evite le message d'erreur lors du test de l'existence de l'instance Excel
On Error Resume Next
'Test l'existence d'une instance Excel
Set xlApp = GetObject(, "Excel.Application")
'Si il n'y en a pas on la crée
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
xlApp_Cree = True
Else
xl_Book_Cree = True
End If
On Error GoTo 0
'On ouvre le fichier Excel
cheminFic = "D:\GARNIER\FG\Application\Rapport\Rapport_.xls"
Set xl_Book = xlApp.Workbooks.Open(cheminFic)
Set xl_Sheet = xl_Book.ActiveSheet
'Split de message avec comme paramètre "WAN" et stockage dans le tableau myArray
myArray = Split(message, "WAN")
'Pour chaque ligne récupérée dans le tableau pendant le traitement du message
For i = 0 To UBound(myArray())
'Si il s'agit d'un site à accès bloqué, on insère la ligne dans le tableau myArrayB,
If myArray(i) Like "*blocked*" Then
ReDim Preserve myArrayB(0 To m)
myArrayB(m) = ReplaceStr(myArray(i))
m = m + 1
'Sinon, si il s'agit d'un accès autorisé, on récupère le début de la chaine dans le tableau myArrayD
ElseIf myArray(i) Like "*Access site*" Then
ReDim Preserve myArrayD(0 To n)
myArrayD(n) = ReplaceStr(myArray(i))
n = n + 1
'et on récupère la fin de cette chaine dans le tableau myArrayE (à cause de la précense des 2 "WAN"
'dans les chaines représentant un accès autorisé
ElseIf myArray(i) Like " - Destination*" Then
ReDim Preserve myArrayE(0 To o)
myArrayE(o) = ReplaceStr(myArray(i))
o = o + 1
ElseIf myArray(i) Like "*IP packet*" Then
ReDim Preserve myArrayG(0 To p)
myArrayG(p) = ReplaceStr(myArray(i))
p = p + 1
End If
Next i
With xl_Sheet
'Split de chaque ligne de myArrayB avec comme paramètre " - " et stockage dans le tableau myArrayC
For j = 0 To UBound(myArrayB())
myArrayC = Split(myArrayB(j), " - ")
ReDim Preserve myArrayC(0 To UBound(myArrayC()))
.Range("A" & j + .Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, UBound(myArrayC()) + 1) = myArrayC
Next j
'Split de chaque ligne de myArrayD associé à myArrayE avec comme paramètre " - " et stockage dans le tableau myArrayF
For k = 0 To UBound(myArrayD())
myArrayF = Split(myArrayD(k) & myArrayE(k), " - ")
ReDim Preserve myArrayF(0 To UBound(myArrayF()))
.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Resize(, UBound(myArrayF()) + 1) = myArrayF
Next k
For q = 0 To UBound(myArrayG())
myArrayH = Split(myArrayG(q), " - ")
ReDim Preserve myArrayH(0 To UBound(myArrayH()))
.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Resize(, UBound(myArrayH()) + 1) = myArrayH
Next q
'Suppression Cellules Vides & Mise en forme
For l = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
With .Cells(l, 2)
If .Offset(0, -1).Text = "" Then
.Offset(0, -1).Delete xlToLeft
End If
End With
Next
'Permet la suppresion du jour (ex : "Mon") pour n'avoir que la date
Set laPlage = .Range("A2:A" & .Cells(Rows.Count, 2).End(xlUp).Row)
For Each cel In laPlage
For x = 1 To Len(cel)
If IsNumeric(Mid(cel, x, 1)) Then
y = x
Exit For
End If
Next x
'Pb depuis l'ajout de l'ouverture du fichier
If Len(cel) <> 0 Then
cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
End If
Next cel
End With
'Destruction des tableaux dynamiques
Erase myArray
Erase myArrayB
Erase myArrayC
Erase myArrayD
Erase myArrayE
Erase myArrayF
'Si on avai lancé une instance Excel on la ferme
If xlApp_Cree Then
xlApp.Quit
ElseIf xl_Book_Cree Then
xl_Book.Close
End If
'On décharge les objets en mémoire
Set xlApp = Nothing
Set xl_Book = Nothing
Set xl_Sheet = Nothing
End Sub
'Fonction permettant de supprimer les informations inutiles
Function ReplaceStr(strCh As String) As String
Dim replaceStr1 As String, replaceStr2 As String, replaceStr3 As String, replaceStr4 As String, replaceStr5 As String
replaceStr1 = Replace(strCh, "[Forward]", "")
replaceStr2 = Replace(replaceStr1, "Source:", "")
replaceStr3 = Replace(replaceStr2, "LAN", "")
replaceStr4 = Replace(replaceStr3, ",", " ")
replaceStr5 = Replace(replaceStr4, "Destination:", "")
ReplaceStr = Replace(replaceStr5, " [Drop] - [Targa3 Attack] ", "")
End Function
Merci d'avance, bonne journée !
Peace :)