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?