Discussion :

[pepsister]

Bonjour,

J'ai créé une macro dans une règle. A réception d'un type de mail, je vérifie si la date de réception est comprise entre le mardi et le samedi et si c'est le cas j'enregistre la pièce jointe.
Pour récupérer la date de réception j'utilise:

Code :

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

1
2
 
MyMail.CreationTime

Cependant, le lundi quand j'ouvre ma boite de réception, mes opérations ne se lancent pas. Pourtant je reçois un mail tous les jours samedi et dimanche compris. Du coup, le mail de samedi aurait dû lancé la macro. Mais le fait d'éteindre outlook le weekend et de le relancer le lundi matin j'ai l'impression qu'il récupère en date de réception non pas la date d'envoi de l'email (samedi) mais la date de mise à jour dans ma boite mail. Je ne sais pas si je suis très claire?
Je souhaite récupérer la date affichée dans la colonne 'Reçu' de la boite de réception d'outlook.

Comment puis-je faire pour corriger ce problème outre laisser ma boite de réception ouverte et mon poste allumé tout le weekend?

[Oliv-]

Bonjour,
Utilises tu le "mode exchange mis en cache" ? il devrait permettre de traiter tes règles à la réouverture de ol

sinon la date de reception c'est plutot .ReceivedTime

[pepsister]

j'ai changé en receivedtime, maintenant faut que j'attende lundi pour voir ce que ça donne à l'ouverture de ma messagerie.

J'ai rencontré aussi un autre problème à l'ouverture d'outlook. Comme je reçois tous les jours un mail qui déclenche la macro, le lundi j'ai donc trois mails déclencheurs.
De ce fait, les trois m'ouvrent Excel, sachant que les deux autres m'ouvrent le fichier en lecture seule vu qu'il est déjà ouvert une fois et donc la macro plante.
Y-a-t-il un moyen pour qu'il traite d'abord le mail le plus ancien, tant que le traitement de ce dernier n'est pas fini, il ne lance pas en parallèle la même macro pour un mail plus récent?

[kuchiky]

Bonjours,

Tu peux contourner le problème en faisant en sorte que ta macro s'active sur chaque mail non lu, de ce fait, avec un for each, tu n'aurais plus ce problème.

En plus de cela, faire le test chaque lundi n'est pas vraiment pratique ne crois-tu pas?

[Oliv-]

Salut,
quel est ton code ?

[pepsister]

je ne fais pas le test chaque lundi. En fait la règle qui lance ma macro tourne dès que ma boite outlook est ouverte. Donc quand j'ouvre ma boite mail le lundi, si la règle est respectée ca lance la macro.
La macro est censée tester la date de réception du mail. Si c'est un dimanche ou lundi on supprime le mail sinon on enregistre les pièces jointes et on lance excel. Et là si je suis absente plusieurs jours du coup excel se lance plusieurs fois à l'ouverture d'outlook et il y a interférence donc le premier s'exécute et les autres excel s'ouvrent en lecture seule.

La règle est la suivante:

Code :

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

1
2
 
Si le mail vient de pep@gmail.com et contient test dans l'objet alors exécuter la macro

La macro:

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
 
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
    Dim olNS As Outlook.NameSpace
    Dim MyMail As Outlook.MailItem
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
   'Récupération de la date de réception du mail
   Dim DateRecep As Date
   Dim DateExcel As String
   DateRecep = Format(MyMail.ReceivedTime, "dd/mm/yyyy")
   DateExcel = Format(MyMail.ReceivedTime, "yyyymmdd")
(là j'ai changé en receivedtime j'attends de voir lundi prochain ce que ca donne)
 
  'Si le mail est compris entre mardi et samedi alors on lance la macro sinon on supprime le mail
  If Weekday(DateRecep, vbTuesday) < 6 Then
  If MyMail.Attachments.Count > 0 Then
      expediteur = MyMail.SenderEmailAddress
        'on crée le répertoire où mettre les fichiers joints 
      Repertoire = "c:\temp\pj\"
      If Repertoire <> "" Then
       If "" = Dir(Repertoire, vbDirectory) Then
         MkDir Repertoire
       End If
      End If
      'on traite les pj
       Dim PJ, typeatt
       For Each PJ In MyMail.Attachments
       'vérification si c'est une PJ Embedded
       typeatt = Isembedded(strID, PJ.Index)
       If typeatt = "" Then
        If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then
          'on informe qu'il existe déjà       
          MsgBox Repertoire & PJ.FileName & " existe !!"
          'si existe copie vers le répertoire old
          If "" = Dir(Repertoire & "old", vbDirectory) Then
          MkDir Repertoire & "old"
          End If
          FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName
        End If
        PJ.SaveAsFile Repertoire & PJ.FileName
      End If
      Next PJ     
   End If
 
Set MyMail = Nothing
Set olNS = Nothing
 
'ouvrir excel
'Déclaration des variables
  Dim appExcel As New Excel.Application    'Application Excel
  Dim wbExcel As Excel.Workbook    'Classeur Excel
  Dim wsExcel As Excel.Worksheet    'Feuille Excel
 
 
  Const LANCE_EXCEL = "C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE /cmd/"
  Const FICHIER_AR = " C:\projets\test.xlsm"
  proc = Shell(LANCE_EXCEL & DateExcel & FICHIER_AR, vbNormalFocus)
 
Else
MyMail.Delete
End If
 
Fin:

[kuchiky]

Code :

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

1
2
3
Dim appExcel As New Excel.Application    'Application Excel
  Dim wbExcel As Excel.Workbook    'Classeur Excel
  Dim wsExcel As Excel.Worksheet    'Feuille Excel

Pourquoi déclarer des variables non utilisé?

Essai en fermant ton processus Excel :

Code :

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

1
2
3
4
  Const LANCE_EXCEL = "C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE /cmd/"
  Const FICHIER_AR = " C:\projets\test.xlsm"
  proc = Shell(LANCE_EXCEL & DateExcel & FICHIER_AR, vbNormalFocus)
  kill proc

[Oliv-]

Salut,

Je suppose que tu as dans ton fichier excel, une macro qui se déclenche à l'ouverture ?

Ce que tu peux faire c'est faire une pause si ton classeur excel s'ouvre en lecture seule, sauf qu'avec ton code c'est pas possible.

il faut utiliser la méthode que je t'ai donné dans un autre sujet


et tu mets dans outlook

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
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
 
Sub Ouverture_avec_verif_ReadOnly()
 'Déclaration des variables
  Dim appExcel As New Excel.Application    'Application Excel
  Dim wbExcel As Excel.Workbook    'Classeur Excel
  Dim wsExcel As Excel.Worksheet    'Feuille Excel
 
  Const FICHIER_AR = "C:\projets\test.xlsm"
 
    On Error Resume Next
    Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
    Stop
    While thisWBK.ReadOnly = True
       Sleep 3000
        appExcel.DisplayAlerts = False
        wbExcel.Close False
       Set wbExcel = Application.Workbooks.Open(FICHIER_AR)
        Application.DisplayAlerts = True
 
    Wend
 
    'suite du code si ouverture en écriture
    appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
    'où ouverture est le nom de ta macro
 
 
End Sub

et il faut supprimer ta macro auto_open ou Workbook_Open() dans ton fichier excel
si tout ton code est dans Workbook_Open() tu la renomme en Ouverture

[pepsister]

Alors j'ai tout modifié comme tu précises oliv.
Du coup ce matin, la macro se met forcément en mode déboggage sur le 'stop'.
Je ne sais pas à quoi sert le 'on error resume next' mais du coup il va systématiquement dedans et stop la macro. une intervention manuelle est donc obligatoire.
Ensuite j'ai aucun fichier excel d'ouvert et il rentre systématiquement dans la boucle while du coup il fait sleep 3000 en boucle.
Je n'y comprends plus grand chose du coup.

[Oliv-]

Salut,
il faudrait que tu publies ton code

[pepsister]

ben j'ai mis ce que tu as mis. Donc voici mon code sous outlook déjà:

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
73
 
 
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
 
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
    Dim olNS As Outlook.NameSpace
    Dim MyMail As Outlook.MailItem
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
   'Récupération de la date de réception du mail
   Dim DateRecep As Date
   Dim DateExcel As String
   DateRecep = Format(MyMail.ReceivedTime, "dd/mm/yyyy")
   DateExcel = Format(MyMail.ReceivedTime, "yyyymmdd")
 
'Si le mail est compris entre mardi et samedi alors on lance la macro sinon on supprime le mail
  If Weekday(DateRecep, vbTuesday) < 6 Then
  If MyMail.Attachments.Count > 0 Then
    expediteur = MyMail.SenderEmailAddress
    Repertoire = "c:\temp\pj\"
    If Repertoire <> "" Then
      If "" = Dir(Repertoire, vbDirectory) Then
      MkDir Repertoire
      End If
    End If
 
'on traite les pj
   Dim PJ, typeatt
   For Each PJ In MyMail.Attachments
     typeatt = Isembedded(strID, PJ.Index)
     If typeatt = "" Then
        If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then
        MsgBox Repertoire & PJ.FileName & " existe !!"
          If "" = Dir(Repertoire & "old", vbDirectory) Then
          MkDir Repertoire & "old"
          End If
          FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName
       End If
       PJ.SaveAsFile Repertoire & PJ.FileName
    End If
  Next PJ
 End If
 
 Set MyMail = Nothing
 Set olNS = Nothing
 
'ouvrir excel
'Déclaration des variables
 Dim appExcel As New Excel.Application    'Application Excel
 Dim wbExcel As Excel.Workbook    'Classeur Excel
 Dim wsExcel As Excel.Worksheet    'Feuille Excel
 Const LANCE_EXCEL = "C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE /cmd/"
 Const FICHIER_AR = " C:\projets\test.xlsm"
 On Error Resume Next
 Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
 Stop
 While thisWBK.ReadOnly = True
   Sleep 3000
   appExcel.DisplayAlerts = False
   wbExcel.Close False
   Set wbExcel = Application.Workbooks.Open(FICHIER_AR)
   Application.DisplayAlerts = True
   Wend
'suite du code si ouverture en écriture
  appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
  'où ouverture est le nom de ta macro
Else
MyMail.Delete
End If
Fin:
End Sub

[Oliv-]

Oups j'ai fait des erreurs en adaptant avec tes données !

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
73
 
 
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
 
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
    Dim olNS As Outlook.NameSpace
    Dim MyMail As Outlook.MailItem
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
   'Récupération de la date de réception du mail
   Dim DateRecep As Date
   Dim DateExcel As String
   DateRecep = Format(MyMail.ReceivedTime, "dd/mm/yyyy")
   DateExcel = Format(MyMail.ReceivedTime, "yyyymmdd")
 
'Si le mail est compris entre mardi et samedi alors on lance la macro sinon on supprime le mail
  If Weekday(DateRecep, vbTuesday) < 6 Then
  If MyMail.Attachments.Count > 0 Then
    expediteur = MyMail.SenderEmailAddress
    Repertoire = "c:\temp\pj\"
    If Repertoire <> "" Then
      If "" = Dir(Repertoire, vbDirectory) Then
      MkDir Repertoire
      End If
    End If
 
'on traite les pj
   Dim PJ, typeatt
   For Each PJ In MyMail.Attachments
     typeatt = Isembedded(strID, PJ.Index)
     If typeatt = "" Then
        If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then
        MsgBox Repertoire & PJ.FileName & " existe !!"
          If "" = Dir(Repertoire & "old", vbDirectory) Then
          MkDir Repertoire & "old"
          End If
          FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName
       End If
       PJ.SaveAsFile Repertoire & PJ.FileName
    End If
  Next PJ
 End If
 
 Set MyMail = Nothing
 Set olNS = Nothing
 
'ouvrir excel
'Déclaration des variables
 Dim appExcel As New Excel.Application    'Application Excel
 Dim wbExcel As Excel.Workbook    'Classeur Excel
 Dim wsExcel As Excel.Worksheet    'Feuille Excel
 Const LANCE_EXCEL = "C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE /cmd/"
 Const FICHIER_AR = " C:\projets\test.xlsm"
 On Error Resume Next
 Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
 'Stop
 While wbExcel.ReadOnly = True
   Sleep 3000
   appExcel.DisplayAlerts = False
   wbExcel.Close False
   Set wbExcel = Application.Workbooks.Open(FICHIER_AR)
   Application.DisplayAlerts = True
   Wend
'suite du code si ouverture en écriture
  appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
  'où ouverture est le nom de ta macro
Else
MyMail.Delete
End If
Fin:
End Sub

[pepsister]

Il rentre toujours dans la boucle While wbExcel.ReadOnly = True, du coup il doit considérer que le fichier est en lecture seule et j'atteins le sleep 3000 à chaque fois jusqu'à killer la macro.
Sachant qu'aucun fichier excel ne s'ouvre.

cette commande:
Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
est censée ouvrir excel ou pas?

Pourquoi sans ouvrir le fichier il le considère en lecture seule?

[Oliv-]

Excel s'ouvre mais ne s'affiche pas forcément il faut lui demander
si tu essaye d'ouvrir le fichier manuellement et qu'il s'ouvre en lecture seule c'est qu'il est déjà ouvert mais sans doute pas visible (appExcel.Visible = True)
regarde dans ton gestionnaire de taches.

à la fin de ta macro "ouverture" il faut bien sûr fermer le fichier excel.
modifie de la sorte :

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
'ouvrir excel
'Déclaration des variables
 Dim appExcel As New Excel.Application    'Application Excel
 Dim wbExcel As Excel.Workbook    'Classeur Excel
 Dim wsExcel As Excel.Worksheet    'Feuille Excel
 
Const FICHIER_AR = " C:\projets\test.xlsm"
 Const FICHIER_AR = "U:\Développement informatique\MACRO\_TESTS\readonly.xlsm"
 On Error Resume Next
 Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
 'Stop
 appExcel.Visible = True
 While wbExcel.ReadOnly = True
   Sleep 3000
   appExcel.DisplayAlerts = False
   wbExcel.Close False
   Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
   appExcel.DisplayAlerts = True
   Wend
'suite du code si ouverture en écriture
  appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
  'où ouverture est le nom de ta macro

[pepsister]

J'ai modifié ma macro avec les modifications que tu précises.
D'une part Excel ne s'ouvre pas malgré le 'appExcel.Visible=True'
D'autre part, aucun Excel d'ouvert et pourtant il rentre à l'infini dans le sleep 3000

[Oliv-]

Bonjour,

Essaye seulement cette partie là et met un ' devant On Error Resume Next

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
 
 
sub test_excel ()
'ouvrir excel
'Déclaration des variables
 Dim appExcel As New Excel.Application    'Application Excel
 Dim wbExcel As Excel.Workbook    'Classeur Excel
 Dim wsExcel As Excel.Worksheet    'Feuille Excel
 
Const FICHIER_AR = " C:\projets\test.xlsm"
' Const FICHIER_AR = "U:\Développement informatique\MACRO\_TESTS\readonly.xlsm"
' On Error Resume Next
 Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
 'Stop
 appExcel.Visible = True
 While wbExcel.ReadOnly = True
   Sleep 3000
   appExcel.DisplayAlerts = False
   wbExcel.Close False
   Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
   appExcel.DisplayAlerts = True
   Wend
'suite du code si ouverture en écriture
  appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
  'où ouverture est le nom de ta macro
end sub

[Oliv-]

en fait c'est l'espace qui pose problème là

Code :

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

Const FICHIER_AR = " C:\projets\test.xlsm"

à changer en

Code :

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

Const FICHIER_AR = "C:\projets\test.xlsm"

et tu peux ajouter un test s'il ne trouve pas le fichier du tout
ou
en retirant le on error resume next tu auras aussi un message système

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
 Dim appExcel As New Excel.Application    'Application Excel
 Dim wbExcel As Excel.Workbook    'Classeur Excel
 Dim wsExcel As Excel.Worksheet    'Feuille Excel
 
 Const FICHIER_AR = "C:\projets\test.xlsm"
 'On Error Resume Next
 Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
 'Stop
 appExcel.Visible = True
 If wbExcel Is Nothing Then MsgBox "Fichier :" & FICHIER_AR & vbCr & "non trouvé": Exit Sub
 While wbExcel.ReadOnly = True
   Sleep 3000
   DoEvents
   appExcel.DisplayAlerts = False
   wbExcel.Close False
   Set wbExcel = appExcel.Workbooks.Open(FICHIER_AR)
   appExcel.DisplayAlerts = True
   Wend
'suite du code si ouverture en écriture
  appExcel.Run wbExcel.Name & "!ouverture", Left(CStr(DateExcel), 10)
  'où ouverture est le nom de ta macro

[pepsister]

Alors en faisant ça, j'ai le message d'erreur suivant sur la ligne:

Code :

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

1
2
 
set wbExcel=appExcel.Workbooks.open(FICHIER_AR)

message d'erreur:
erreur d'exécution '429', un composant ActiveX ne peut pas créer l'objet

Je me souviens maintenant que c'est pour cela que je suis passé par la commande shell pour lancer excel, car je n'ai trouvé aucun moyen pour ne pas avoir ce message d'erreur.
A priori c'est dû à une librairie non existante sur Outlook 2007et les autres ne sont pas compatibles. J'avais posté déjà un post à ce sujet qui n'avais pas été résolu.

[Oliv-]

as tu essayé de réparer office 2007 ?

[pepsister]

j'ai retrouvé la discussion où l'on avait parlé de ce problème, en effet c'est toi oliv qui m'avait répondu et rien n'avait fonctionné dans les solutions trouvées.
http://www.developpez.net/forums/d14...macro-outlook/