Microsoft 365 VBA sur outlook

lesoldat9 · 15 Mai 2023

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 · 16 Mai 2023

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 · 16 Mai 2023

Oneida à dit:
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 · 16 Mai 2023

Re,
Pris en compte par qui ou quoi?

lesoldat9 · 16 Mai 2023

Oneida à dit:
Re,
Pris en compte par qui ou quoi?

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

Oneida · 16 Mai 2023

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

Pourquoi du VBA Outlook pour traiter un fichier Excel?

lesoldat9 · 22 Mai 2023

Oneida à dit:
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 · 22 Mai 2023

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

VB:

For i = 1 To UBound(UM)

sur Ubound(UM)

lesoldat9 · 22 Mai 2023

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

VB:

For i = 1 To UBound(UM)

sur Ubound(UM)

J'ai Ubound(UM)=3

Oneida · 22 Mai 2023

lesoldat9 à dit:
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

VB:

If test = "EURO" Then

pour verifier le contenu de test

lesoldat9 · 26 Mai 2023

Oneida à dit:
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

VB:

If test = "EURO" Then

pour verifier le contenu de test

Re,

test = vide

...

Oneida · 26 Mai 2023

Bonjour,

UM est une table, elle sort d'ou?

lesoldat9 · 30 Mai 2023

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 · 30 Mai 2023

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 · 8 Juin 2023

Oneida à dit:
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.

Microsoft 365 VBA sur outlook

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

lesoldat9

XLDnaute Occasionnel

Discussions similaires