IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Exportation du corps d'un email provenant de outlook vers un fichier excel [XL-2003]


Sujet :

Macros et VBA Excel

  1. #21
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bon j'ai encore un petit soucis, ça faisait longtemps^^

    J'ai ajouté l'ouverture du fichier et du coup ça m'a raouté un message d'erreur

    Mon code modifié :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    'REP_FICHIER est une cnstante que j'ai déclaré et qui contient le chemin du classeur excel.
    'message est une variable qui correspond a strChaine, mais elle est passée en paramètre.
    '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
    
    
    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
    
    Dim j As Integer, k As Integer, l 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
     
    
    'On désactive la mise à jour de l'écran pour accélérer l'exécution du code
    Application.ScreenUpdating = False
    
    '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
            
        End If
     
    Next i
    
    
    
    '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 = REP_FICHIER
    Set xl_Book = xlApp.Workbooks.Open(cheminFic)
    Set xl_Sheet = xl_Book.Worksheets(1)
    
    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
        
        
        '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'ouverure du fichier
                cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
            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 réactive la mise à jour de l'écran
    Application.ScreenUpdating = True
    
    '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
            
            replaceStr1 = Replace(strCh, "[Forward]", "")
            
            replaceStr2 = Replace(replaceStr1, "Source:", "")
            
            replaceStr3 = Replace(replaceStr2, "LAN", "")
            
            replaceStr4 = Replace(replaceStr3, ",", " ")
            
            ReplaceStr = Replace(replaceStr4, "Destination:", "")
     
    End Function

    Le message d'erreur est sur l'instruction que j'ai mise en rouge, et le message d'erreur est le suivant : Erreur d'exécution 5 : Argument ou appel de procédure incorrect..

    Je me dit que j'ai peut-être omis certaines choses en ajoutant l'ouverture de la feuille ?!


    Merci par avance


    Peace

    Bonjour !

    Bon je viens de comprendre une petite chose : je récupère le corps du mail, mais j'ai l'impression que je ne récupère pas tout.. du coup je pense que ça doit être un soucis au niveau du type de variable, mais je vois pas pourquoi faire sans string et sans variant alors que j'ai bien moins de caractères que la maximum possible...

    Merci d'avance !!

    Peace

  2. #22
    Membre averti Avatar de casavba
    Profil pro
    Inscrit en
    juillet 2007
    Messages
    455
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : juillet 2007
    Messages : 455
    Points : 323
    Points
    323
    Par défaut
    je récupère le corps du mail, mais j'ai l'impression que je ne récupère pas tout..
    Bonjour,

    Si t'as utilisé deux procédure ---> une pour récupérer le corps de mail et l'autre pour le traitement. Il est clair que dans la deuxième procédure la variable "message" sera vide tant que tu ne l'as pas déclaré en public.

    Il faut la déclarer à l'extérieure de toute les procédures comme suit :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Public message As String
    Sinon, j'ai testé le code --> il fonctionne même si je suis pas d'accord avec la manière avec laquelle tu l'as formulé. Bref, il fonctionne.

    Concernant la question de la boucle. J'ai mis un "Exit For" parce que je voudrais récupérer l'emplacement de la première occurrence numérique de la chaine "Mon 2009..." . C'est l'emplacement de cette occurence qui va permettre par le biais d'un traitement de chaine de caractère d'extraire que la date.

    @+

  3. #23
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Salut casavba !!

    Et bien en fait ce n'est pas que ma variable est vide, mais réellement que je ne récupère pas tout ! J'ai ajouté un espion sur ma variable, elle a bien une valeur, qui représente le message, mais seulement 1/5 à peu près...

    Du coup je vais la déclarer tout de même en variable Public, mais je ne pense pas que le soucis vienne de la ! Je fais appel à une procédure mais je passe ma variable en paramètre donc elle ne devrait pas être vide !?!!

    Sinon, je pense que c'est à cause de ça que j'ai le message d'erreur à la ligne suivante :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
    Sinon, je voulais savoir ce qui pose problème dans la formulation de mon code ? :$ Merci d'avance !

    Peace

    Bon je viens enfin de comprendre pourquoi ça me déclenche une erreur ! Je ne sais pas pourquoi mais je sais d'ou elle vient !

    En fait , c'est dans la boucle :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
     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
                cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
     
            Next cel
    Je sais qu'elle fonctionnait Lorsque j'utilisais une variable contenant la chaine à traiter, mais plus depuis que j'ai ajoute la récupération du body dans outlook ! En fait il arrive un moment où le Len(cel) à la valeur 0 !! c'est à ce moment là que mon erreur est générée.

    toute aide est la bienvenue^^

    Peace

    Je viens enfin de trouver mon problème...
    et je m'excuse de ne pas avoir vu ça avant.......

    En fait j'ai recommencé encore une fois en pas à pas, ligne par ligne.. Et en fait je me suis rendu compte qu'une des valeurs récupérées était différentes des autres :


    Mon, 2009-10-26 09:11:38 - Attempt to access blocked sites - Source:10.122.128.2,LAN - Destination:yahoo.astrocenter.fr/imgmails/picto/fr/90x90tth.gif,WAN
    Mon, 2009-10-26 09:13:34 - IP packet - Source:10.122.128.19,LAN - Destination:239.255.255.250,WAN [Drop] - [Targa3 Attack] Mon, 2009-10-26 09:16:17 - Access site - Source:10.122.128.13,WAN - Destination:www.leadium.com,WAN - [Forward]

    Cette ligne n'est présente q'une seule fois, et étant donnée la quantité de lignes dans le mail, je ne l'avais tout simplement pas vu !

    Donc je pense qu'il faudrait rajouté un tableau pour prendre en compte ce message, mais du coup ca complique les choses avec les séparateurs !?

    Je vais essayer de rajouter un test quand c'est égal à IP packet, j'espère que c'est possible^^

    Peace

  4. #24
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bon je suis assez déçu finalement :/ ^^

    J'ai rajouté le code suivant pour gérer le problème que j'ai cité précédemment :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    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
        
        ElseIf myArray(i) Like "*IP packet*" Then
                ReDim Preserve myArrayG(0 To p)
                myArrayG(p) = ReplaceStr(myArray(i))
                p = p + 1
                
        End If 
    
        '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
            
        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
    
        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
        
        '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
    Mais malgré ça je reviens toujours à la même erreur avec le Len(cel) = 0...

    Peace

  5. #25
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bonjour a tous ! si il y a encore des gens ce qui n'est pas certain

    J'ai donc encore un peu avancé.
    Mon problème vient du fait que à la fin de mon traitement, lorsque je concatène les deux tableaux, ils ne sont pas de la même taille :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    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
    En effet, chaque ligne "Access site" renvoi obligatoirement une une ligne "Destination". Il n'est donc pas normal que les deux tableaux soient différents. J'ai donc recommencé au pas à pas, et je me suis rendu compe de quelque chose de très bizarre...

    Certaines lignes, comme " - Destination:liveupdate.symantecliveupdate.com," sont évidemment insérées dans le tableau qui listent les lignes comprenant "* - Destination*".

    Et certaines lignes, comme "- Destination:c.astrocenter.fr," ne sont pas enregistrées dans le tableau...

    Toutefois, il arrive que tous les enregistrements se soient bien passés mais l'erreur survient quand même à la ligne "habituelle" avec un appel de méthode ou de procédure incorrect étant donné que le Len(cel) est vide :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
    Est-il possible que mon erreur provienne de la fonction qui est censée suprrimer les cellules vides ? Etant donnée que mon erreur vient du fait que le Len(cel) prenne la valeur zéro...


    Je vous redonne la fonction pour supprimer les lignes pour pas que vous ayez à la rechercher :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    For q = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
         With .Cells(q, 2)
             If .Offset(0, -1).Text = "" Then
                .Offset(0, -1).Delete xlToLeft
             End If
         End With
    Next


    Enfin voila je crois que je ne comprends plus trop d'où peut venir l'erreur..

    Merci à la personne qui sera capable de m'aider à résoudre ce problème !

    Peace

  6. #26
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2005
    Messages : 12 464
    Points : 15 273
    Points
    15 273
    Par défaut
    Ne n'est pas Len(LeMotVide) qui pose problème, c'est Mid(sur un mot vide)
    Tu as deux solutions : Ou tu mets une gestion d'erreur qui permet de poursuivre l'exécution (On error resume next à gérer) ou tu places un test sur la présence de texte dans Cel, test conditionnant l'exécution de la ligne de code incriminée.
    C'est toi qui vois
    Bonne journée

    Edit
    Autant pour moi, Mid sur un mot vide ne provoque pas d'erreur, c'est Cdate appliqué à du vide
    Teste ça
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Sub test()
    Dim Mot As String
        Mot = Empty
        MsgBox Len(Mot)
        MsgBox Mid(Mot, 2, 2)
        Msgbox CDate(Mid(Mot, 2,2)) 'erreur 'Incompatibilité de type"
    End Sub
    Tu dois donc effectivement tester la chaîne et s'il s'agit bien d'une date. Regarde IsDate dans l'aide en ligne.

  7. #27
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bonjour à toi et merci pour ta réponse !
    Bon en fait, c'est dans le code suivant qu'il y a le déclenchement de l'erreur :


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    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
                    cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
            Next cel
    Et en fait, il y a un moment où Len(cel) est vide. En fait j'ai fait des test sur différents messages. Si il ne s'agit que d'accès autorisés, tout se colle parfaitement. Si il s'agit d'accès bloqués qui sont listés ensemble dans le message ça marche également. Par contre si je retrouve un accès blocked à deux endroits différents dans mon message il me met le message d'erreur.

    J'avais déjà essayé avec une gestion d'erreurs, mais le truc c'est que du coup dans mon fichier excel c'est plus très propre :S Donc je suppose qu'il doit y avoir un soucis avec les accès bloqués ?!

    Sinon je vais me renseigner sur IsDate !

    Enfin une dernière petite chose : je pense qu'il y a peut-etre un saut de ligne caché, enfin je veux dire par là qui n'est pas visible, et donc qui m'ajoute une cellule vide dans mon fichier excel. Pourtant je suis censé les supprimer avant.. à moins que le saut ligne indique que la cellule n'est pas vide ?

    Si c'est possible je pense qu'il faut juste que je gère la suppression des sauts de ligne avant de supprimer les cellules vides ! Mais est-ce que c'est possible au moins ?

    Merci d'avance !

    Peace

  8. #28
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2005
    Messages : 12 464
    Points : 15 273
    Points
    15 273
    Par défaut
    Le test que tu dois mettre est sur la ligne cel.value = ...
    Maios je partirais d'un test sur la longueur de Cel.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
            For Each cel In laPlage
                If Len(cel) <> 0 then
                    For x = 1 To Len(cel)            
                        If isNumeric(Mid(cel, x, 1)) Then
                             y = x
                             Exit For
                        End If
                    Next x
                endif
                if isdate(Mid(cel.Text, y, Len(cel) - y + 1)) then _
                         cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
            Next cel
    Tu testes

  9. #29
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Salut !

    Bon alors, j'ai testé mais j'ai le même message d'erreur à la ligne :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If IsDate(Mid(cel.Text, y, Len(cel) - y + 1)) Then
    Et c'est toujours à cause du fait qu'il y est une cellule vide.. Donc j'en reviens à la suppression des sauts de page^^ si bien sûr ils peuvent être considérés comme des caractères ?!

    Peace

    Bonjour à nouveau !

    Bon alors, j'en suis arrivé à ce résultat :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
           For Each cel In laPlage
                If Len(cel) <> 0 Then
                    For x = 1 To Len(cel) <> 0
                        If IsNumeric(Mid(cel, x, 1)) Then
                            y = x
                            Exit For
                        End If
                    Next x
                        cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
                Else
                    Rows(cel.Row).Delete shift:=xlUp
                End If
            Next cel
    Je n'ai plus de message d'erreur, et pour certains messages tout se passent très bien

    Malheureusement, pour d'autres, et même si je n'ai plus de messages d'erreurs, mon fichier excel n'est pas du tout rempli correctement.. En fait tout les "Access site" sont bien insérés, et après le premier "Attempt to blocked sites" c'est un grand n'importe quoi :/

    Je crois que je vais tout simplement péter un câble ^^

    Merci à ceux qui ont une idée Je pense qu'il y à peut-être un caractère invisible que je ne gère pas ? Enfin là j'ai de plus en plus l'impression que j'arrivrais pas à résoudre mon problème :/ ^^

    Peace

    Bon alors, j'ai encore un petit peu avancé^^

    Je vais bien finir par arriver au bout^^

    Donc alors, j'ai utilisé un logiciel , ultraEdit, qui m'a permit de voir le message sous différentes formes (Hexa,Ascii,...). Et donc, en Ascii, je me suis rendu compte que à la fin de chaque ligne correspondant à un accès bloqué, il y avait un reoutr chariot suivi d'un saut de ligne (enfin je pense, si c'est bien la traduction de Line Feed) !

    Et donc j'ai ajouté une petite fonction :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    message = SupprCar(message)
     
    Function SupprCar(msg As String) As String
        Dim supprCar1 As String, supprCar2 As String
     
        supprCar1 = Replace(msg, Chr(10), "")
        SupprCar = Replace(supprCar1, Chr(13), " ")
    End Function
    Et donc là tout est bien séparé : les dates dans la colonne date, les accès dans la colonne Type d'accès, etc..
    Sauf que comme tout à l'heure, les accès autorisés sont tous bien collés, alors que pour les autres accès, il y en a un sur deux qui est comme il faut ( c'est à dire 26/10/2009 09:19:25 au lieu de Mon 2009-10-26 09:25:27).

    Je vais continuer ma recherche, mais je vois pas pourquoi ça bloquerait un coup sur deux comme ca :/

    Si quelqu'un veutque je lui envoi le message pour qu'il puisse tester directement avec un vrai message c'est pas un problème !

    Peace

  10. #30
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bonjour à tous !

    Bon j'ai enfin réussi à résoudre mon problème ^^

    Mais pour le moment, je revois tout ça et je mets tout bien en place ! Je posterais une source pour que d'autres personnes puissent en profiter parce que j'ai vraiment galéré !!! Je mettrais le lien en réponse

    Et donc, au moins pour que vous sachiez d'où ça venait :

    Tout d'abord, j'ai un classeur avec l'appli et un classeur de test ! Celui de test fonctionnait mais je n'arrivais pas avec celui de l'appli. En en fait, j'avais une de mes constantes qui était "FORWARD" au lieu de "Forward", donc ça posait bêtement problème.. Mais ce n'est pas ça qui me posait réellement problème. En continuant avec UltraEdit, j'ai également découvert un autre caractère qui était présent dans le corps du mail. Il était présent énormément et au départ je n'ai pas vérifié car j'ai cru que c'était un simple espace.. Et finalement, avec chaque espace il y a un caractère (DC4, Device Control 4, Chr(20)), et c'est lui qui me posait problème.

    J'en profite pour m'excuser au près des personnes qui testaient et pour qui tout marchait très bien : vous ne pouviez avoir mes erreurs que si vous aviez testé avec un email, et qui plus est un qui contiennent les mêmes caractères marsqués... Mais bon, si j'avais su avant je vous aurai pas laissé chercher inutilement. Sachant que j'avais déjà pensé aux caractères masqués, mais je n'avais rien vu avant d'utiliser UltraEdit (bien plus performant que d'afficher les caractères sous Word où je ne sait qu'elle application basique)

    En tout cas merci beaucoup à ceux qui m'ont aidé, et principalement un grand merci à casavba pour tout le temps qu'il a pu me consacrer

    A très bientôt, je peaufine tout ça et je vous envoi ça

    Bonne journée, Peace

  11. #31
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Salut à tous !

    Bon et bien finalement j'ai pas trouvé pour poster une source, j'ai peut-être pas encore les droits, il faut peut-être déjà être membre ?? Du coup je vais quand même vous donnez ma solution, en fait jvais vous donner l'ensemble de mes modules ^^ Vous inquiétez pas, ce sera un peu long mais clair :$ ^^ Je vais envoyer une réponse pour chaque module !

    Vous créez un projet : vous y ajouter 5 modules, que j'ai nommé :

    - proc_general
    - proc_disque
    - proc_txtMail
    - proc_ficExcel
    - proc_chaine

    J'ai mit dans ThisWorkbook l'appel de procédure :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Private Sub Workbook_Open()
        'Module proc_general
        Init_Application
    End Sub
    J'ai également deux boutons que vous devez rajouter sur la feuille Excel où se situe l'application (faites juste deux boutons pas besoin du reste c'est de la déco..). Ils lancent tout les deux une procédure :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Private Sub BT_GENERATION_Click()
    'Correspond au module proc_txtMail
        RecuperationCorpsMsg
    End Sub
     
    Private Sub BT_QUITTER_Click()
    'Module proc_general
        Quitter_Application
    End Sub
    Dans le premier module, proc_general, je déclare mes constantes et j'initalise une mon application (c'est une appli simple avec un bouton générer et un bouton quitter) :

    Module proc_general :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    Option Explicit
    'Déclaration des constantes et variables
     
    'Constante en rapport avec le fichier généré
    Public Const NOM_FICHIER = "Rapport_"
    Public Const EXT_FICHIER = ".xls"
    Public Const REP_FICHIER = "C:\User\Rapport"
     
    'Constante utilisée pour tester et ne traiter que les emails qui correspondent
    Public Const ADR_MAIL = "adresse@domaine.fr"
    Public Const OBJ_MAIL = "NETGEAR Security Log [57:5A:C2]"
     
    'Constante pour accéder au bon dossier de la messagerie
    Public Const DOSSIER_PERSONNEL = "Dossiers personnels"
    Public Const DOSSIER_RECEPTION = "Boîte de réception"
    'Correspond au dossier dans la boite de réception
    Public Const NOM_DOSSIER = "Suivi Acces"
     
    'Constantes représentants les séparateurs utilisés pour les split du mail
    Public Const SEP_MSG_A = "WAN"
    Public Const SEP_MSG_B = " - "
     
    'Constante représentants les différents types d'accès
    Public Const TYP_STR_A = "*blocked*"
    Public Const TYP_STR_B = "*IP packet*"
    Public Const TYP_STR_C = "*Access site*"
    'Ici il y en a deux car il peut s'agir de l'une ou l'autre forme dans le mail
    Public Const TYP_STR_D1 = "*- Destination*"
    Public Const TYP_STR_D2 = "*-Destination*"
     
    'Constantes correspondant aux caractères qui seront supprimés dans les chaines
    Public Const CAR_SUP_A = " - [Forward]"
    Public Const CAR_SUP_B = "Source:"
    Public Const CAR_SUP_C = "LAN"
    Public Const CAR_SUP_D = ","
    Public Const CAR_SUP_E = "Destination:"
    Public Const CAR_SUP_F = " [Drop] - [Targa3 Attack] "
     
    'Constantes correspondant aux caractères invisbles suprrimés dans le message
    Public CHR_SUP_A As String
    Public CHR_SUP_B As String
    Public CHR_SUP_C As String
     
     
    ' Initialisation de l'application
    Sub Init_Application()
     
        CHR_SUP_A = Chr(10)
        CHR_SUP_B = Chr(13)
        CHR_SUP_C = Chr(20)
        ThisWorkbook.Worksheets("Accueil NomApplication").Activate
        With ActiveWindow
            .DisplayHorizontalScrollBar = False
            .DisplayVerticalScrollBar = False
            .DisplayHeadings = False
            .DisplayWorkbookTabs = False
            .DisplayGridlines = False
            .WindowState = xlMaximized
            .Visible = True
        End With
     
        With Application
            .DisplayAlerts = False
            .SheetsInNewWorkbook = 1
            .DisplayFormulaBar = False
        End With
        Range("F13").Select
     
    End Sub
     
    ' Quitter l'application, correspond au bouton
    Sub Quitter_Application()
     
        With Application
            .SheetsInNewWorkbook = 3
        End With
        ThisWorkbook.Close
    End Sub
    La suite dans le prochain post ^^

  12. #32
    Membre du Club
    Profil pro
    Étudiant
    Inscrit en
    mai 2008
    Messages
    80
    Détails du profil
    Informations personnelles :
    Âge : 34
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : mai 2008
    Messages : 80
    Points : 58
    Points
    58
    Par défaut
    Bon alors, je continu avec le module proc_disque. J'ai mit dans ce module mes fonctions qui ont un accès au disque de données :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    Option Explicit
     
    ' Création d'un répertoire
    Function Creation_Repertoire(cheminrepertoire As String)
     
    Dim fs As Object
     
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FolderExists(cheminrepertoire) = False Then
       fs.CreateFolder (cheminrepertoire)
       Creation_Repertoire = True
    Else
       Creation_Repertoire = False
    End If
    End Function
     
    'Vérification de l'existence du fichier Excel
    Public Function ExistFile(strpath As String) As Boolean
     
    Dim fs As Object
     
    Set fs = CreateObject("Scripting.FileSystemObject")
    ExistFile = fs.FileExists(strpath)
    End Function
     
    ' Test si fichier ouvert
    Function Fic_ouvert(fic_nom As String)
     
        Dim wb As Workbook
     
        Fic_ouvert = True
        On Error GoTo fin
        Set wb = Workbooks(fic_nom)
        Set wb = Nothing
        Exit Function
    fin:
        Fic_ouvert = False
        On Error GoTo 0
    End Function
    Toutes ces fonctions utilisent une variable qui est passé en paramètre dans un autre module.

    J'en arrive au module proc_txtMail, qui me permet d'accéder à outlook :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    Option Explicit
    'Lance la récupération du corps du message
    Sub RecuperationCorpsMsg()
        ConnexionOutlook
    End Sub
     
    'Connexion à Outlook
    Sub ConnexionOutlook()
    Dim co_outlookapp As Object
    Dim co_olnomdomaine As Object
    Dim co_oldossier As Object
    Dim co_olmailitem As Object
    Dim co_orderinfo As String
    Dim co_cheminfichier As String
    Dim co_flgoutlook As Boolean
    Dim co_flgfic As Boolean
    Dim co_xlbook As Workbook
    Dim i As Long
    Dim j As Long
     
    co_flgfic = True
    co_flgoutlook = False
    co_orderinfo = ""
    co_cheminfichier = ""
     
     
    ' Test de l'ouverture d'Outlook
    Set co_outlookapp = CreateObject("Outlook.Application")
    If co_outlookapp.Explorers.Count = 0 Then
        co_flgoutlook = True
    End If
     
    ' Création du répertoire
    Creation_Repertoire (REP_FICHIER)
     
    ' Test si fichier Excel existe
    co_cheminfichier = REP_FICHIER & "\" & NOM_FICHIER & EXT_FICHIER
    If ExistFile(co_cheminfichier) Then
        ' Test si fichier ouvert
        If Fic_ouvert(co_cheminfichier) = False Then
             Set co_xlbook = Workbooks.Open(co_cheminfichier)
        Else
            MsgBox "Le fichier Excel est déjà ouvert.", vbOKOnly + vbInformation, _
            "Tentative d'ouverture du fichier Excel"
            co_flgfic = False
        End If
    Else
        'Creation du fichier excel
        Set co_xlbook = Workbooks.Add
        'Appel de la procédure de mise en forme, Module proc_ficExcel
        FormatFicExcel co_xlbook
        'Enregistrement du fichier
        co_xlbook.SaveAs co_cheminfichier
    End If
     
    If co_flgfic Then
     
        'Permet l'accès aux données stockées Outlook de l'utilisateur
        Set co_olnomdomaine = co_outlookapp.GetNamespace("MAPI")
     
        'Indique quel dossier doit être traité, ici un dossier personnel de la boite de réception
        Set co_oldossier = co_olnomdomaine.Folders(DOSSIER_PERSONNEL).Folders(DOSSIER_RECEPTION)
        Set co_oldossier = co_oldossier.Folders(NOM_DOSSIER)
     
        'Boucle permettant de traiter tout les messages de la boite de réception
        For Each co_olmailitem In co_oldossier.Items
     
            'Si l'objet du mail et l'adresse de l'expéditeur correspondent
            If Trim(co_olmailitem.Subject) = OBJ_MAIL And Trim(co_olmailitem.SenderEmailAddress) = ADR_MAIL Then
     
                'Si il ne s'agit pas d'un message déjà lu et traité
                If co_olmailitem.UnRead = True Then
     
                    'Et si le corps du message n'est pas vide
                    If Len(Trim(co_orderinfo)) > 0 Then
                        co_orderinfo = co_olmailitem.Body
                        'On fait appel à la procédure intégrant les informations dans le fichier Excel
                        InsertIntoExcel co_xlbook, co_orderinfo
                        'On indique que le message est lu
                        co_olmailitem.UnRead = False
                    End If
                End If
            End If
        Next
     
        co_xlbook.Save
        co_xlbook.Close
    End If
     
    'Si on avai lancé une instance Outlook on la ferme
    If co_flgoutlook Then
        co_outlookapp.Quit
    End If
     
    'On décharge les objets en mémoire
    Set co_oldossier = Nothing
    Set co_olnomdomaine = Nothing
    Set co_olmailitem = Nothing
    Set co_outlookapp = Nothing
    End Sub
    co_flgfic est un boolean qui me permet de savoir si mon fichier rapport est déjà ouvert, si 'est le cas je ne peux pas le modifier (lecture seule), je sorts de la procédure.

    InsertIntoExcel est une procédure qui fait l'insertion des infos dans le fichier excel "Rapport". Elle est dans le module proc_ficExcel qque je vous décrirais après. Je passe le classeur dans lequel je vais intégrer les infos en paramètre, et la variable qui contient le corps du message.

    Maintenant je vous mets le module le plus important, en taille et au niveau production^^

    Il permet de créer le fichier Rapport, et après d'insérer les données dans ce fichier :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    Option Explicit
     
    'Mise En Forme Fichier Excel
    Sub FormatFicExcel(ff_classeur As Workbook)
     
    'Création de la feuille
    ff_classeur.Worksheets("feuil1").Activate
    ff_classeur.Worksheets("feuil1").Name = "Suivi Internet"
     
    'Déclaration des colonnes
    ff_classeur.Worksheets("Suivi Internet").Cells(1, 1) = "Date et Heure"
    ff_classeur.Worksheets("Suivi Internet").Cells(1, 2) = "Type d'accès"
    ff_classeur.Worksheets("Suivi Internet").Cells(1, 3) = "Source"
    ff_classeur.Worksheets("Suivi Internet").Cells(1, 4) = "Destination"
     
    'Propriétés de la plage de cellules Titres
    ff_classeur.Worksheets("Suivi Internet").Range("A1:D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
     
    'Propriétés de la police d'écriture
    With Selection.Font
        .Bold = True
        .Name = "Microsoft Sans Serif"
        .Size = 10
    End With
     
    'Ajustement automatique des colonnes au texte
    ff_classeur.Worksheets("Suivi Internet").Range("A:A").ColumnWidth = 14.57
    ff_classeur.Worksheets("Suivi Internet").Range("B:B").ColumnWidth = 27.57
    ff_classeur.Worksheets("Suivi Internet").Range("C:C").ColumnWidth = 12.57
    ff_classeur.Worksheets("Suivi Internet").Range("D:D").ColumnWidth = 62
     
    ff_classeur.Worksheets("Suivi Internet").Range("A1").Select
    End Sub
     
    'Procédure permettant le traitement du message, et l'insertion dans le fichier Excel
    Sub InsertIntoExcel(ii_classeur As Workbook, ii_message As String)
     
    Dim ii_myarray() As String, _
    ii_myarrayb() As String, ii_myarrayd() As String, ii_myarrayf() As String, ii_myarrayg() As String, _
    ii_myarrayc() As String, ii_myarraye() As String, ii_myarrayh() As String
     
    Dim a As Integer
     
    Dim i As Integer
     
    Dim 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
    m = 0
    n = 0
    o = 0
    p = 0
     
    ii_message = SupprCar(ii_message)
     
    'Split de message avec comme paramètre "WAN" et stockage dans le tableau myarray
    ii_myarray = Split(ii_message, SEP_MSG_A)
     
    'Pour chaque ligne récupérée dans le tableau pendant le traitement du message
    For i = 0 To UBound(ii_myarray())
     
        'Si il s'agit d'un site à accès bloqué, on insère la ligne dans le tableau myarrayb.
        If ii_myarray(i) Like TYP_STR_A Then
            ReDim Preserve ii_myarrayb(0 To m)
            ii_myarrayb(m) = ReplaceStr(ii_myarray(i))
            m = m + 1
        'Sinon, si il s'agit d'un IP packet, on insère la ligne dans le tableau myarrayd.
        Else
            If ii_myarray(i) Like TYP_STR_B Then
                ReDim Preserve ii_myarrayd(0 To n)
                ii_myarrayd(n) = ReplaceStr(ii_myarray(i))
                n = n + 1
            'Sinon, si il s'agit d'un accès autorisé, on récupère le début de la chaine dans le tableau myarrayf,
            Else
                If ii_myarray(i) Like TYP_STR_C Then
                    ReDim Preserve ii_myarrayf(0 To o)
                    ii_myarrayf(o) = ReplaceStr(ii_myarray(i))
                    o = o + 1
                Else
                    'et si on récupère bien la fin de cette chaine, on l'insère dans le tableau myarrayg
                    '(à cause de la présense des 2 "WAN" dans les chaines représentant un accès autorisé)
                    If ii_myarray(i) Like TYP_STR_D1 Or ii_myarray(i) Like TYP_STR_D2 Then
                        ReDim Preserve ii_myarrayg(0 To p)
                        ii_myarrayg(p) = ReplaceStr(ii_myarray(i))
                        p = p + 1
                    End If
                End If
            End If
        End If
    Next i
     
    With ii_classeur.Worksheets(1)
        'Si le tableau contenant les accès bloqués n'est pas vide,
        'Split de chaque ligne de myarrayb avec comme paramètre " - " et stockage dans le tableau myarrayc.
        If m > 0 Then
            For j = 0 To UBound(ii_myarrayb())
                ii_myarrayc = Split(ii_myarrayb(j), SEP_MSG_B)
                ReDim Preserve ii_myarrayc(0 To UBound(ii_myarrayc()))
                .Range("A" & j + .Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, UBound(ii_myarrayc()) + 1) = ii_myarrayc
            Next j
        End If
        'Si le tableau contenant les IP packet n'est pas vide,
        'Split de chaque ligne de myarrayd avec comme paramètre " - " et stockage dans le tableau myarraye
        If n > 0 Then
            For k = 0 To UBound(ii_myarrayd())
                ii_myarraye = Split(ii_myarrayd(k), SEP_MSG_B)
                ReDim Preserve ii_myarraye(0 To UBound(ii_myarraye()))
                .Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Resize(, UBound(ii_myarraye()) + 1) = Trim(ii_myarraye)
            Next k
        End If
        'Si le tableau contenant les accès autorisés n'est pas vide,
        'Split de chaque ligne de myarrayf associé à myarrayg avec comme paramètre " - " et stockage dans le tableau myarrayh
        If o > 0 Then
            For l = 0 To UBound(ii_myarrayf())
                    ii_myarrayh = Split(ii_myarrayf(l) & ii_myarrayg(l), SEP_MSG_B)
                    ReDim Preserve ii_myarrayh(0 To UBound(ii_myarrayh()))
                    .Range("A" & .Cells(Rows.Count, 3).End(xlUp).Row + 1).Resize(, UBound(ii_myarrayh()) + 1) = ii_myarrayh
            Next l
        End If
     
        'Permet la suppression du jour (ex : "Mon") pour n'avoir que la date
        'On lance l'instruction deux fois pour formater une cellule
        'qui n'a pas pu être formaté dans la première exécution
        Set laplage = .Range("A2:A" & .Cells(Rows.Count, 2).End(xlUp).Row)
        For a = 1 To 2
            For Each cel In laplage
                If Len(cel) <> 0 Then
                    For x = 1 To Len(cel) <> 0
                        If IsNumeric(Mid(cel, x, 1)) Then
                            y = x
                            Exit For
                        End If
                    Next x
                    cel.Value = CDate(Mid(cel.Text, y, Len(cel) - y + 1))
                Else
                    Rows(cel.Row).Delete shift:=xlUp
                End If
            Next cel
        Next a
    End With
     
    'Destruction des tableaux dynamiques
    Erase ii_myarray
    Erase ii_myarrayb
    Erase ii_myarrayc
    Erase ii_myarrayd
    Erase ii_myarraye
    Erase ii_myarrayf
    Erase ii_myarrayg
    Erase ii_myarrayh
     
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.
Page 2 sur 2 PremièrePremière 12

Discussions similaires

  1. Exportation du corps d'un email provenant de outlook vers un fichier excel
    Par byonatane dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 08/11/2013, 14h31
  2. Réponses: 26
    Dernier message: 17/07/2008, 14h17
  3. [Outlook] --> exportation d'emails vers un fichier excel?
    Par drexlbob dans le forum VBA Outlook
    Réponses: 0
    Dernier message: 11/11/2007, 14h38
  4. export d'access vers un fichier excel prédéfini
    Par kuhnden dans le forum Access
    Réponses: 3
    Dernier message: 05/01/2006, 22h08
  5. [Excel] PHP-MYSQL exportation de données vers un fichier excel
    Par toure32 dans le forum Bibliothèques et frameworks
    Réponses: 4
    Dernier message: 19/10/2005, 19h29

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo