Discussion :

[FFGUY]

Bonjour a tous,

Je recois tous les jours 2 mails que j aimerais combiner.
Le 1er est recu a 7h30 et contient a fichier excel.
Le 2eme est recu a 16h30 et contient les infos dans le corps du mail.

A la reception du deuxieme, j aimerais automatiquement creer un mail qui reprends une partie du corps du mail du deuxieme + Ajouter un nouveau titre et une nouvelle liste de distribution + joindre l excel recu le matin dans le 1er email.

J ai deja une macro qui tourne et qui sauve le fichier excel sur mon ordi.

Je comprends qu il faut que je cree une regle qui lancera une macro qui fera l ensemble des taches ci dessus.
Quelqu un aurait il une idee sur comment faire ce que je souhaite?

Merci d'avance

[FFGUY]

Re bonjour,

j ai cree deux Macros pour m aider a arriver a mes fins, une qui sauvegarde en automatique le fichier que je recois tous les matins a 7h30:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub saveResults(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
        saveFolder = " MYPATH      "
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        Set objAtt = Nothing
    Next
End Sub

Ensuite, a 16h30 quand je recois mon rapport, j ai fait une rule qui declenche la macro ci dessous qui me permet d updater un fichier excel avec les differentes donnees de mon emails :

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
Sub CopyToExcel(item As Outlook.MailItem)
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim olItem As Outlook.MailItem
 Dim vText As Variant
 Dim sText As String
 Dim vItem As Variant
 Dim i As Long
 Dim rCount As Long
 Dim bXStarted As Boolean
 Const strPath As String = "  MY PATH  " 
 
 If Application.ActiveExplorer.Selection.Count = 0 Then
     MsgBox "No Items selected!", vbCritical, "Error"
     Exit Sub
 End If
 On Error Resume Next
 Set xlApp = GetObject(, "Excel.Application")
 If Err <> 0 Then
     Application.StatusBar = "Please wait while Excel source is opened ... "
     Set xlApp = CreateObject("Excel.Application")
     bXStarted = True
 End If
 On Error GoTo 0
 'Open the workbook to input the data
 Set xlWB = xlApp.Workbooks.Open(strPath)
 Set xlSheet = xlWB.Sheets("Sheet1")
 
 'Process each selected record
  rCount = xlSheet.UsedRange.Rows.Count
   For Each olItem In Application.ActiveExplorer.Selection
     sText = olItem.Body
     vText = Split(sText, Chr(13))
     'Find the next empty line of the worksheet
      rCount = rCount + 1
     'Check each line of text in the message body
     For i = UBound(vText) To 0 Step -1
 
         If InStr(1, vText(i), "YTD Volume:") > 0 Then
             vItem = Split(vText(i), Chr(58))
             xlSheet.Range("A5") = Trim(vItem(1))
         End If
 
         If InStr(1, vText(i), "YTD PnL:") > 0 Then
             vItem = Split(vText(i), Chr(58))
             xlSheet.Range("B5") = Trim(vItem(1))
         End If
 
         If InStr(1, vText(i), "YTD USD/mio:") > 0 Then
             vItem = Split(vText(i), Chr(58))
             xlSheet.Range("C5") = Trim(vItem(1))
         End If
     Next i
     xlWB.Save
 Next olItem
 xlWB.Close SaveChanges:=True
 If bXStarted Then
     xlApp.Quit
 End If
 Set objExcel = CreateObject("Excel.Application")
 Set objWorkbook = objExcel.Workbooks.Open(" OTHER PATH ")
 objExcel.Visible = True
 'Start my macro contained in my excel file
objExcel.Run "Module1.Send_Range"
 
 Set xlApp = Nothing
 Set xlWB = Nothing
 Set xlSheet = Nothing
 Set olItem = Nothing
 End Sub

Comme vous pouvez le voir ci dessus cette Macro lance aussi une macro contenue dans Excel:

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
 
Sub Send_Range()
 Application.DisplayAlerts = False
   ' Select the range of cells on the active worksheet.
   ActiveSheet.Range("A1:C9").Select
 
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
 
   With ActiveSheet.MailEnvelope
      .Item.To = "Jean@bon.fr"
      .Item.Subject = "$$$results"
      .Item.attachments.Add ("  MY PATH ")
      .Item.Display
      .Item.Send
   End With
ActiveWorkbook.Close Savechanges = False
Application.DisplayAlerts = True
End Sub

Je suis pas loin de ce que je veux faire mais 2 problemes:
1- Ma macro outlook lance bien ma macro excel mais reste bloque sur

Code :

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

objExcel.Run "Module1.Send_Range"

2- Lorsque ma macro excel se lance, je suis oblige de "yes" le security warning d'Outlook. (Je voudrais bien me servir Sendkeys mais je ne sais pas comment l inclure dans mon code)

Y a t il une ame charitable pour me debloquer svp ?

Merci,

[FFGUY]

Pour eviter que mon code bug sur l execution de la macro Excel j ai juste rajouter "On Error resume next " sur la ligne precedente.
Ca fait ce que je veux mais ce n est pas tres proper et il me reste toujours le security warning de outlook lors de l envoi de l email.

Je viens aussi de m 'apercevoir que si je ne selectionne pas le mail en fait ma macro ne va pas chercher l information pour updater mon excel...