Verification du Code

Bonjour a tous ,

je ne m y connait trop en VBA je suis debutante et la j ai recu un Excercice de mon Patron. Il recoit plusieurs Email de son Outlook et voudrais avoir certain information(ID, Sujet et Date d entree) Automatiquement dans excel. Voici le code que j ai ecrit mais il ne s excecute pas je voudrais savoir a quel niveau est ce qu il ya erreur. Merci

Sub getdatafromOutlook()

Dim OutlookApp As Outlook.Application

Dim OutlookNamespace As Namesapce

Dim Folder As MAPIFolder

Dim outlookMail As Variant

Dim i As Integer

Dim ID As Integer

Set Outlook = New Outlook.Application

Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")

i = 1

For Each outlookMail In Folder.Items

If outlookMail.ReceivedTime >= Range("Eingangsdatum").Value Then

Range("ID").Offset(i, 0) = outlookMail.objekt

Range("ID").Offset(i, 0).Columns.AutoFit

Range("ID").Offset(i, 0).VerticalAlignement.xlTop

Range("Betreff").Offset(i, 0).Value = outlookMail.Betreff

Range("Betreff").Offset(i, 0).Columns.AutoFit

Range("Betreff").Offset(i, 0).VerticalAlignement.xlTop

Range("Eingangsdatum").Offset(i, 0).Value = outlookMail.ReceivedTime

Range("Eingangsdatum").Offset(i, 0).Columns.AutoFit

Range("Eingangsdatum").Offset(i, 0).VerticalAlignement.xlTop

i = i + 1

End If

Next outlookMail

Set Folder = Nothing

Set OutlookNamespace = Nothing

Set OutlookApp = Nothing

End Sub

Bonjour,

une proposition de correction, quelques fautes de frappe. Ne pas oublier de référencer outlook dans VBA (via menu outils-references)

Sub getdatafromOutlook()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim outlookMail As Variant
    Dim i As Integer
    Dim ID As Integer

    Set OutlookApp = New Outlook.Application

    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")

    i = 1

    For Each outlookMail In Folder.Items

        If outlookMail.ReceivedTime >= Range("Eingangsdatum").Value Then
            Range("ID").Offset(i, 0) = outlookMail.objekt
            Range("ID").Offset(i, 0).Columns.AutoFit
            Range("ID").Offset(i, 0).VerticalAlignement.xlTop
            Range("Betreff").Offset(i, 0).Value = outlookMail.Betreff
            Range("Betreff").Offset(i, 0).Columns.AutoFit
            Range("Betreff").Offset(i, 0).VerticalAlignement.xlTop
            Range("Eingangsdatum").Offset(i, 0).Value = outlookMail.ReceivedTime
            Range("Eingangsdatum").Offset(i, 0).Columns.AutoFit
            Range("Eingangsdatum").Offset(i, 0).VerticalAlignement.xlTop

            i = i + 1
        End If

    Next outlookMail

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

ps: la prochaine fois, merci de mentionner également le message d'erreur que tu reçois, si tu en reçois un. "Ca ne marche pas", ça n'aide pas beaucoup pour identifier la cause du problème. Surtout si on ne dispose pas de tout le contexte. (ici on n'a pas tes folder outlook, ni tes messages)

Merci pour la reponse elle m a permi d avancer

le probleme est au niveau de " Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")" ca dit que l objet n a pas été retrouvé.

Bonsoir,

vérifie la hiérarchie des répertoires outlook. as-tu bien un répertoire nommé "Impmail" dans le répertoire par défaut pour ton inbox ?

la première lettre de Impmail est-elle un L ou un i (L minuscule et i majuscule peuvent prêter à confusion, car ils se ressemblent très fort Il).

Bjr,

merci infiniment c etait exactement un probleme de hierachie

bonjour a tous,

Dans le Body du Email j ai juste besoin d extraire une serie de chiffre .je ne sais comment m y prendre existe t il une formule pour cela ? de preference un code. par exemple jai quelque chose comme ceci mais je veux juste les chiffre

( chdhaufhudjv fvbsduhvofvid sbshuvaji 4538738 fhfduodjjnl ).Merci

j ai oublier de preciser que c est en VBA

bonjour,

voici une fonction vba qui permet d'extraire un nombre présent dans une chaîne de caractères.

Function ExtraireNombre(texte) As Double

    Set regex = CreateObject("vbscript.regExp")
    regex.Pattern = "\d+"
    regex.Global = True

    If (regex.test(texte) = True) Then
        Set d = regex.Execute(texte)
        ExtraireNombre = d.Item(0).Value
    End If
End Function

à utiliser ainsi

Sub test()
texte="( chdhaufhudjv fvbsduhvofvid sbshuvaji 4538738 fhfduodjjnl )"
    MsgBox ExtraireNombre(texte)
End Sub

bonjour ,

merci pour la solution mais elle ne marche pas .je t envoie le document Excel pour que ca soit plus clair. le texte en question est dans ID .il y a deux ID dans le texte et j ai juste besoin du premier .

bonjour

essaie ainsi

Option Explicit
Sub getdatafromOutlook()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim outlookMail As Variant
    Dim i As Integer

    Set OutlookApp = New Outlook.Application

    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")

    i = 3

    For Each outlookMail In Folder.Items

        Cells(i, 1).Value = outlookMail.ReceivedTime
        Cells(i, 1).NumberFormat = "dd.mm.yy"
        Cells(i, 2).Value = outlookMail.Subject
        Cells(i, 3).Value = ExtraireNombre(outlookMail.Body)

        i = i + 1

    Next outlookMail

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

Function ExtraireNombre(texte) As Double
    Dim regex As Object, d As Object
    Set regex = CreateObject("vbscript.regExp")
    regex.Pattern = "\d+"
    regex.Global = True

    If (regex.test(texte) = True) Then
        Set d = regex.Execute(texte)
        ExtraireNombre = d.Item(0).Value 'renvoie le premier nombre rencontré
    End If
End Function

bonjour h2so4,

Merci de t intéresser a ma préoccupation .J ai essayer ton code mais le problème est qu il lit uniquement le premier nombre qu il rencontre (7)

Bonjour,

J ai essayer ton code mais le problème est qu il lit uniquement le premier nombre qu il rencontre (7)

ben oui, il lit uniquement le premier nombre qu'il rencontre, c'est ce que tu as demandé !

merci pour la solution mais elle ne marche pas .je t envoie le document Excel pour que ca soit plus clair. le texte en question est dans ID .il y a deux ID dans le texte et j ai juste besoin du premier .

en fait je parlais tu ID qui est dans le texte c est sur cette forme "ID: 37435"

Bonjour,

tu veux donc le premier nombre qui suit les caractères ID:, c'est cà ?

dasn ce cas :

Option Explicit
Sub getdatafromOutlook()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim outlookMail As Variant
    Dim i As Integer

    Set OutlookApp = New Outlook.Application

    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")

    i = 3

    For Each outlookMail In Folder.Items

        Cells(i, 1).Value = outlookMail.ReceivedTime
        Cells(i, 1).NumberFormat = "dd.mm.yy"
        Cells(i, 2).Value = outlookMail.Subject
        Cells(i, 3).Value = ExtraireNombre(outlookMail.Body)

        i = i + 1

    Next outlookMail

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

Function ExtraireNombre(texte) As Double
    Dim regex As Object, d As Object
    Set regex = CreateObject("vbscript.regExp")
    regex.Pattern = "(ID: ?|id: ?)\d+"
    regex.Global = True

    If (regex.test(texte) = True) Then
        Set d = regex.Execute(texte)
        ExtraireNombre = Trim(Mid(d.Item(0).Value, 4)) 'renvoie le premier nombre rencontré après ID:
    End If
End Function

bonjour,

j ai réessayer votre méthode et la ça m affiche juste des zéros .je parle en fait du premier nombre qui suit le caractère ID mais tous le Nombre qui suit ID . Ex: ID 3758 je veux juste 3758 . j ai dit le premier ID parce que dans le texte il y en a deux. voici ce que j ai pu écrire.

Dim derligne%, x2, x3

On Error Resume Next

derligne = Cells(Rows.Count, 2).End(3).Row

For i = 2 To derligne

Cells(i, 4) = ""

x2 = Split(Cells(i, 3), "ID: ")

x3 = Left(x2(1), 3)

Cells(i, 4) = x3

Next i

ça fonctionne mais je veux que ça écrive sur la colonne C mais ça le fait plutôt dans D .Lorsque je remplace le 4 par 3 ça ne lit plus rien.je suis vraiment bloqué. Merci pour ton intérêt.

Bonjour,

voici un code de test qui démontre que la fonction fournie fonctionne.

Function ExtraireNombre(texte) As Double
    Dim regex As Object, d As Object
    Set regex = CreateObject("vbscript.regExp")
    regex.Pattern = "(ID: ?|id: ?)\d+"
    regex.Global = True

    If (regex.test(texte) = True) Then
        Set d = regex.Execute(texte)
        ExtraireNombre = Trim(Mid(d.Item(0).Value, 4))    'renvoie le premier nombre rencontré après ID:
    End If
End Function

Sub test()
    t = "ceci est un test avec ID: 123456 et ID: 6789"
    MsgBox ExtraireNombre(t)
    t = "ceci est un test avec ID : 123456 et ID: 6789"
    MsgBox ExtraireNombre(t)
    t = "ceci est un test avec IDiot: 123456 et IDiot: 6789"
    MsgBox ExtraireNombre(t)
End Sub

ma boule de cristal m'indique qu'il faudrait que tu corriges ton code ainsi.

derligne = Cells(Rows.Count, 3).End(xlup).Row
For i = 2 To derligne
Cells(i, 3) = extrairenombre(cells(i,3).value)
next i

bonjour,

je vous remercie énormément ca fonctionne