Microsoft 365 VBA sur outlook

[lesoldat9]

Bonjour à tous,

J'ai un soucis de références - Projet qui n'est pas disponible.

En effet, la références Microsoft DAO 3.6 Object Library est bien disponible dans les choix mais pas dans le dossier en question
soit C:\Program Files\Common Files\microsoft shared

Le dossier de la référence est pourtant disponible dans le dossier suivant: C:\Program Files (x86)\Common Files\Microsoft Shared

J'ai donc fait un copier coller mais ma macro ne fait pas le lien entre outlook et excel.

Voici mon code:

Sub TT(AGE As String, DAT As String, REFCGT As String, REFESSERS As String, UM As Variant)

Dim XlApp, XlClas
Dim Fichier As String
Utilisateur = Environ("USERNAME")
Fichier = "C:\Users\"& Utilisateur &"\Desktop\Compil Prebooking.xlsm"


'Création d'un Excel
Set XlApp = CreateObject("Excel.Application")
XlApp.DisplayAlerts = False
'Ouverture du classeur
Set XlClas = XlApp.Workbooks.Open(Fichier)

lg = XlClas.Sheets(2).Range("A1").End(xldown).Row + 1
XlClas.Worksheets(2).Range("A" & lg) = AGE
XlClas.Worksheets(2).Range("B" & lg) = DAT
XlClas.Worksheets(2).Range("C" & lg) = REFCGT
XlClas.Worksheets(2).Range("D" & lg) = REFESSERS
For i = 1 To UBound(UM)

test = Trim(Right(UM(i), 4))

If test = "EURO" Then
If i > 1 And XlClas.Worksheets(2).Range("E" & lg) <> "" Then
XlClas.Worksheets(2).Range("E" & lg) = XlClas.Worksheets(2).Range("E" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("E" & lg) = Left(UM(i), 2) * 1
End If
ElseIf test = "PAL" Then
If i > 1 And XlClas.Worksheets(2).Range("F" & lg) <> "" Then
XlClas.Worksheets(2).Range("F" & lg) = XlClas.Worksheets(2).Range("F" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("F" & lg) = Left(UM(i), 2) * 1
End If
ElseIf test = "P6" Then
If i > 1 And XlClas.Worksheets(2).Range("G" & lg) <> "" Then
XlClas.Worksheets(2).Range("G" & lg) = XlClas.Worksheets(2).Range("G" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("G" & lg) = Left(UM(i), 2) * 1
End If
ElseIf test = "QDP" Then
If i > 1 And XlClas.Worksheets(2).Range("H" & lg) <> "" Then
XlClas.Worksheets(2).Range("H" & lg) = XlClas.Worksheets(2).Range("H" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("H" & lg) = Left(UM(i), 2) * 1
End If
ElseIf test = "CIT" Then
If i > 1 And XlClas.Worksheets(2).Range("I" & lg) <> "" Then
XlClas.Worksheets(2).Range("I" & lg) = XlClas.Worksheets(2).Range("I" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("I" & lg) = Left(UM(i), 2) * 1
End If
'*************************************************************************************************************************************

ElseIf test = "CRT" Then
If i > 1 And XlClas.Worksheets(2).Range("J" & lg) <> "" Then
XlClas.Worksheets(2).Range("J" & lg) = XlClas.Worksheets(2).Range("J" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("J" & lg) = Left(UM(i), 2) * 1
End If
'*************************************************************************************************************************************

Else
If i > 1 And XlClas.Worksheets(2).Range("K" & lg) <> "" Then
XlClas.Worksheets(2).Range("K" & lg) = XlClas.Worksheets(2).Range("K" & lg) + (Left(UM(i), 2) * 1)
Else
XlClas.Worksheets(2).Range("K" & lg) = Left(UM(i), 2) * 1
End If
End If
Next i
XlClas.Worksheets(2).Range("L" & lg).FormulaR1C1 = "=RC[-1]+RC[-2]+RC[-3]+RC[-4]+RC[-5]+RC[-6]+RC[-7]"
' XlClas.Worksheets(2).Range("M" & lg).FormulaR1C1 = "=RC[-7]+RC[-6]+RC[-5]/2+RC[-4]/4+RC[-3]*1.25"
XlClas.Worksheets(2).Range("M" & lg).FormulaR1C1 = "=RC[-8]+RC[-7]+RC[-6]/2+RC[-5]/4+RC[-4]*1.25"
'Sauvegarde des modifications et fermeture du classeur
XlClas.Save
XlClas.Close True
'On quitte Excel
XlApp.Quit
'On libère la mémoire des variables
XlApp.DisplayAlerts = True
Set XlClas = Nothing
Set XlApp = Nothing

End Sub

Quelqu'un pour m'aider?

 

[Oneida]

Bonjour,

Je ne vois pas ce que la ref DAO 3.6 vient faire dans le code que vous presentez, y a pas de connection.

 

[lesoldat9]

Bonjour,

Je ne vois pas ce que la ref DAO 3.6 vient faire dans le code que vous presentez, y a pas de connection.

D'accord mais ma macro n'est pas pris en compte et je ne comprend pas pourquoi

 

[Oneida]

Re,
Pris en compte par qui ou quoi?

 

[lesoldat9]

Re,
Pris en compte par qui ou quoi?

Ma macro passe directement à end sub après Set XlApp = CreateObject("Excel.Application")

 

[Oneida]

Vous savez mettre un point d'arret sur une ligne de code?

Pourquoi du VBA Outlook pour traiter un fichier Excel?

 

[lesoldat9]

Vous savez mettre un point d'arret sur une ligne de code?

Pourquoi du VBA Outlook pour traiter un fichier Excel?

Bonjour,

Oui pour le point d'arrêt.
En mettant le stop sur la ligne de code : lg = XlClas.Sheets(2).Range("A1").End(xldown).Row + 1
la macro après le code suivant: Set XlClas = XlApp.Workbooks.Open(Fichier) passe à End sub directement.

vba Outlook pour traiter un fichier excel oui.
Pour faire simple à la réception de mon mail le tableau excel est rempli automatiquement et le mail est supprimé.

 

[Oneida]

Bonjour,
Recommencez avec votre Stop. Quand le programme s'arrete, passez le curseur souris sur Fichier pour voir son contenu et a cette ligne

For i = 1 To UBound(UM)

sur Ubound(UM)

 

[lesoldat9]

Bonjour,
Recommencez avec votre Stop. Quand le programme s'arrete, passez le curseur souris sur Fichier pour voir son contenu et a cette ligne

For i = 1 To UBound(UM)

sur Ubound(UM)

J'ai Ubound(UM)=3

 

[Oneida]

J'ai Ubound(UM)=3

Re,
Ok.
de 0 a 2 ou de 1 a 3 pour UM?
Dans tous les cas, vous commencez la boucle a 1 et vos test i >1, donc y kake chose qui ne va pas.

Il faudrait mettre un point d'arret ici

If test = "EURO" Then

pour verifier le contenu de test

 

[lesoldat9]

Re,
Ok.
de 0 a 2 ou de 1 a 3 pour UM?
Dans tous les cas, vous commencez la boucle a 1 et vos test i >1, donc y kake chose qui ne va pas.

Il faudrait mettre un point d'arret ici

If test = "EURO" Then

pour verifier le contenu de test

Re,

test = vide

...

 

[Oneida]

Bonjour,

UM est une table, elle sort d'ou?

 

[lesoldat9]

Bonjour,

Elle sort de la macro principale qui fait appel à celle-ci voir ci-dessous:

Public AGE As String, DAT As String, REFCGT As String, REFESSERS As String, UM As String, TabUM As Variant

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'Declaration des variables

Dim arrID() As String
Dim i As Integer, j As Integer
Dim ns_outlook As Outlook.NameSpace
Dim item_outlook As MailItem
Dim itm As Outlook.MailItem
Dim expedtideur As String
Dim object As String
Dim texte As String
Dim TabUM As Variant

On Error Resume Next
Set ns_outlook = Application.Session

'Séparer le matricule de l'objet Outllok
arrID = Split(EntryIDCollection, ",")

'Boucle sur l'objet Outlook
For i = 0 To UBound(arrID)
Set item_outlook = ns_outlook.GetItemFromID(arrID(i))

If item_outlook.Class = olMail Then
Set itm = item_outlook
expediteur = itm.SenderName
object = itm.Subject
texte = itm.Body
If object = "REF Chargement ESSERS/DIVERSEY" Then
AGE = Left(texte, 3)
If AGE <> "GON" And AGE <> "LIL" Then
itm.Delete
Set ns_outlook = Nothing
Set item_outlook = Nothing
Set itm = Nothing
Exit Sub
End If
pos1 = InStr(1, texte, Chr(10)) + 1
DAT = Mid(texte, pos1, 8)
DAT = Right(DAT, 4) & Mid(DAT, 3, 2) & Left(DAT, 2)
pos2 = pos1 + 10
REFCGT = Mid(texte, pos2, 7)
pos3 = pos2 + 9
REFESSERS = Mid(texte, pos3, 10)
pos4 = pos3 + 12
UM = Mid(texte, pos4, 100)
TabUM = Split(UM, "|")
Call TT(AGE, DAT, REFCGT, REFESSERS, TabUM)
itm.Delete
End If
End If
Next i
'Remise à zéro

Set ns_outlook = Nothing
Set item_outlook = Nothing
Set itm = Nothing

End Sub

 

[Oneida]

Bonjour,

Mettez un point d'arret sur la ligne next i
PAssez le curseur souris sur la variable EntryIDCollection, texte. Si elles ne sont pas vide, passez le curseur sur sur toutes les autres variables y compris celles vous passez en parametre pour
Sub TT(AGE As String, DAT As String, REFCGT As String, REFESSERS As String, UM As Variant)

 

[lesoldat9]

Bonjour,

Mettez un point d'arret sur la ligne next i
PAssez le curseur souris sur la variable EntryIDCollection, texte. Si elles ne sont pas vide, passez le curseur sur sur toutes les autres variables y compris celles vous passez en parametre pour
Sub TT(AGE As String, DAT As String, REFCGT As String, REFESSERS As String, UM As Variant)

Je pense avoir compris ou est le problème.
Le bureau du pc est sur Onedrive c'est pour cette raison que ca ne fonctionne plus.