VBA OUTLOOK: incrémentation des dates

**LANGAZOU** · 22/07/2016, 08h42

Bonjour,

j'ai crée une macro sous OUTLOOK qui me permet d'envoyer des mails avec un BODY qui change selon l'heure du système. mon souci c'est de changer le BODY du mail selon l'heure de réception du mail précédent et non pas l'heure du système.un autre problème c'est que lors de l'incrémentation des dates il ne tient pas compte des jours non ouvrables (samedi, dimanche), je voudrais afficher dans le BODY du mail que les jours ouvrables.

ci-dessous mon code:

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
Sub test1()
 
Dim appOutLook As Object
 
Dim MailOutLook As Object
 
Dim strbody As String
 
 
Dat = Date
Tim = DateAdd("d", 1, Dat)
Tim1 = DateAdd("d", 2, Dat)
 
If Time < "08:00" Then
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
 
Else
 
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim1 & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
End If
 
 
Set appOutLook = CreateObject("Outlook.Application")
 
Set MailOutLook = GetCurrentItem.ReplyAll
 
With MailOutLook
 
.Display
.Subject = "Confirmation Date"
.Recipients.ResolveAll
.HTMLBody = strbody & "<br>" & .HTMLBody
.Display
 
End With
 
Set MailOutLook = Nothing
Set appOutLook = Nothing
 
 
End Sub

Merci pour votre aide

**Oliv-** · 22/07/2016, 11h50

selon l'heure de réception du mail précédent

précédent quoi ? tu veux parler de l'heure de réception du Mail auquel tu réponds ?

**LANGAZOU** · 22/07/2016, 12h48

Bonjour OLIVIER,

Oui l'heure de réception du Mail auquel je vais répondre.

**Oliv-** · 22/07/2016, 14h33

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
Sub test1()
 
Dim appOutLook As Object
 
Dim MailOutLook As Object
 
Dim strbody As String
 
 
 
Set appOutLook = CreateObject("Outlook.Application")
Set MailOrigine =  GetCurrentItem
Set MailOutLook = GetCurrentItem.ReplyAll
 
Dat = MailOrigine.ReceivedTime
 
Tim = DateAdd("d", 1, Dat)
Tim1 = DateAdd("d", 2, Dat)
 
If Time < "08:00" Then
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
 
Else
 
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim1 & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
End If
 
With MailOutLook
 
.Display
.Subject = "Confirmation Date"
.Recipients.ResolveAll
.HTMLBody = strbody & "<br>" & .HTMLBody
.Display
 
End With
 
Set MailOutLook = Nothing
Set appOutLook = Nothing
 
 
End Sub

**LANGAZOU** · 27/07/2016, 08h43

Bonjour,

ça ne marche pas olivier, la date insérée dans le BODY reste figée même avec le changement de l'heure du mail précédent. y'a til un moyen de ne pas prendre en considération les jours non ouvrables ? ci-dessous mon code entier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
 
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
 
    Set objApp = Nothing
End Function

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
Sub test1()
 
Dim appOutLook As Object
 
Dim MailOutLook As Object
 
Dim strbody As String
 
 
 
Set appOutLook = CreateObject("Outlook.Application")
Set MailOrigine = GetCurrentItem
Set MailOutLook = GetCurrentItem.ReplyAll
 
Dat = MailOrigine.ReceivedTime
Tim = DateAdd("d", 1, Dat)
Tim1 = DateAdd("d", 2, Dat)
Dat = Format(Dat, "dd/mm/yyyy")
 
If Dat < "09:00" Then
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim1 & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
 
Else
 
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Nous vous confirmons la date du " & Tim & ". <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Cordialement." & "<br>" _
 
End If
 
With MailOutLook
 
.Display
.Subject = "Confirmation Date"
.Recipients.ResolveAll
.HTMLBody = strbody & "<br>" & .HTMLBody
.Display
 
End With
 
Set MailOutLook = Nothing
Set appOutLook = Nothing

Merci pour votre aide

**Oliv-** · 27/07/2016, 17h27

Essaye déjà en enlevant le premier .display
Pour les jours ouvrés tu dois tester le jour avec weekday dans un select case ou un if elseif. ..et changer ta date en conséquence

**LANGAZOU** · 28/07/2016, 12h01

Merci beaucoup.

VBA OUTLOOK: incrémentation des dates

VBA Outlook

Discussions similaires

Partager

Partager