Lire dans un fichier excel fermé depuis VBA Outlook

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

Je suis à la recherche d'une solution pour le problème suivant :

Contexte:

- Dans un fichier excel sont référencés en ligne des appareils qui doivent être étalonnés. En colonne "E" se trouve la date de validité, c'est à dire la date à laquelle ceux-ci devront de nouveau être étalonnés. En colonne "G" se trouve la différence entre la date de validité et la date actuelle. Cette différence décroit donc au fur et à mesure du temps pour tendre vers 0 et peu devenir négative.

- Le fichier excel se trouvera sur le bureau du pc d'un collègue, dans lequel il pourra de façon ponctuelle faire des modifications de dates, ajouter des lignes pour de nouveaux appareils etc..

- Outlook est la messagerie par défaut utilisée sur tout nos postes informatique. Celle-ci est lancée au démarrage de son pc et reste ouverte en continue, le pc est parfois simplement mis en veille en quittant le travail et sorti de veille le lendemain.

Besoin :

J'aurais besoin de votre aide pour réaliser une macro sous VBA Outlook (ma première, je n'ai de l'expérience que sous VBA excel, je préfère donc m'adresser au forums pour éviter les problèmes de syntaxe etc..).
Le but de la macro serait SANS ouvrir le fichier excel, qui se trouvera toujours au même emplacement sur le bureau, de vérifier la différence entre les dates en colonne "G". Si la valeur de cette cellule est inférieure à 30, alors envoyer un mail au responsable de l'appareil en question. On peut imaginer ici positionner l'adresse mail en question dans la colonne "J".

J'avais pensé à quelque chose de ce type en "réfléchissant excel" :
Code:

1 2 3 4 5 6 7 For Each cellule In Range(Cells(4, 7), Cells(65536, 7).End(xlUp)) If cellule.Value <= 30 Then adresse = cellule.Offset(0, 3).Value 'email dans la colonne J Call EnvoiMail 'avec variable public "adresse" et fonction d'envoi de mail End If Next
L'un de vous saurait-il m'éclairer sur la marche à suivre ? Je reste à votre disposition pour toute autre explication du problème ou question.
Dans l'attente de vos réponses,

Ycære

16/07/2020, 13h59
pijaku

Bonjour,

Si tu as de l'expérience en VBA Excel, pourquoi vouloir envoyer tes mails depuis VBA Outlook que tu ne connais pas?

Tu pourrais très bien faire cette procédure depuis ton classeur Excel.

J'envoie quotidiennement des mails, via Outlook, grâce à une macro Excel située dans un classeur Excel...

Après cette réflexion, ta demande est tout à fait réalisable, relativement facilement.
Pour accéder aux onjets Excel (Range etc...) depuis Outlook, il te suffit de cocher la référence (sous VBE Outils/références...) Microsoft Excel xx.x Object Library.

Tu auras ainsi accès aux objets de ton classeur.

La plus grosse difficulté étant : "sans ouvrir le classeur". Mais, là encore, tu trouveras tout ce qu'il te faut sur ce site.

Après réflexion, la référence à Excel n'est pas nécessaire.
On peut se passer des objets Excel...

Par contre : Nécessite de cocher la référence suivante : Microsoft ActiveX Data Objects x.x Library

Pour le coup, voici un exemple de macro qui réalise ce que tu souhaites.
La source principale est en commentaire de cette macro.

Code:

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
Option Explicit
 
Public adresse As String
 
Sub RequeteClasseurFerme()
'   Source : https://silkyroad.developpez.com/VBA/ClasseursFermes/
'   Nécessite de cocher la référence suivante :
    '   Microsoft ActiveX Data Objects x.x Library
    Dim Cn As ADODB.Connection, Rst As ADODB.Recordset
    Dim Fichier As String, NomFeuille As String, texte_SQL As String
    Dim Datas As Variant, i As Long
 
    'Définit le classeur fermé servant de base de données
    Const NOMFICHIER As String = "Le_Nom_De_Mon_Fichier.xlsm"
    Fichier = "C:\Users\" & Environ("username") & "\Desktop\" & NOMFICHIER
 
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "BDD"
 
    Set Cn = New ADODB.Connection
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
    'Ecrit le résultat de la requête dans le Variant Datas
    If Not Rst.EOF Then
        Datas = Rst.GetRows
    Else
        MsgBox "erreur d'importation"
    End If
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
    Set Rst = Nothing
 
    'Boucle sur les valeurs de la colonne 7
    For i = 0 To UBound(Datas)
        If Datas(6, i) <= 30 Then
            adresse = Datas(9, i) 'email dans la "colonne 10" de la variable tableau
            Call EnvoiMail 'avec variable public "adresse" et fonction d'envoi de mail
        End If
    Next i
End Sub

17/07/2020, 08h10
ycære

Bonjour Pijaku,

Merci de ta réponse rapide et complète ! Le pourquoi de Outlook c'est justement pour matcher avec la demande de mon collègue : ne pas passer par un fichier excel, que l'opération vérif+envoi si nécessaire soit vraiment autonome, je m'étais donc dit que ça permettrait de palier ce problème :)

En revanche, quelle est la condition de démarrage de la macro sous Outlook? J'imagine qu'elle ne tourne pas en tache de fond en lecture continue du fichier excel ?

Cordialement,
Ycære
17/07/2020, 09h16
pijaku
Bonjour,

Pour l'instant, elle se déclenche sur lancement de l'utilisateur : Alt+F8, choisir RequeteClasseurFerme et exécuter.

Tu peux, au choix :
1. Ajouter un bouton à la barre d'accès rapide : [à faire sur le poste concerné]
  https://support.microsoft.com/fr-fr/...a-927f84eb5d2c
2. Utiliser un des événements suivants :
  - Application.AdvancedSearchComplete
    Cet événement se produit lorsque la méthode AdvancedSearch est terminée.
  - Application.AdvancedSearchStopped
    Survient lors de l’exécution de la méthode Stop d’un objet Search spécifié.
  - Application.ItemLoad
    Se produit lorsqu'un élément Outlook est chargé en mémoire. i.e. réception d'un mail
  - Application.ItemSend
    Cet événement se produit lorsqu’un élément Microsoft Outlook est envoyé par l’utilisateur i.e. envoi d'un mail
  - etc...
    Voir ici :
    https://docs.microsoft.com/fr-fr/off...searchcomplete
Tu n'as plus qu'à choisir ta méthode de déclenchement et nous tenir informé.

L'avantage d'un événement est que cela ne nécessite aucune intervention de l'utilisateur.
17/07/2020, 10h07
ycære
Bonjour,

Le lancement par event me semble effectivement le meilleur choix pour cette notion "d'autonome". Après avoir parcouru la liste, le plus logique me semble être le Application.Startup, exécution au démarrage après chargement de tout les compléments.

Je vois en revanche à partir de là un problème : Si Outlook est ouvert plusieurs fois dans la journée, cela peut engendrer une pollution des boites mail en cas de d’occurrence dans le fichier excel source.

L'idée serait peut-être d'intégrer un compteur pour n'exécuter la procédure qu'une fois par jour ? Du style :
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim LastExecution As String . . if LastExecution <> Date Then ... End if . . LastExecution = Date End Sub
17/07/2020, 11h18
pijaku

Ce type de procédure pourrait être fait dans le classeur Excel.
Suffit, au lancement de ta macro, de :
> Tester si en feuille "machin", cellule A1, la date saisie est la date du jour,
>>> Si non
>>>>>>Lancer la procédure
>>>>>>Enregistrer la date du jour en en feuille "machin", cellule A1
>>>Si oui on ne fait rien

Ceci peut-être fait dans la procédure événementielle.
Tu t'en occupes ou tu as besoin d'aide?
17/07/2020, 11h24
ycære

Si j'ai bien compris il faut glisser cette instruction dans la partie "définition de la requête" après la connexion avec le fichier excel?
Je veux bien ton aide là dessus le SQL ne me parle pas du tout :roll:

1 pièce(s) jointe(s)

Je te joins le code de là où j'en suis ainsi qu'un fichier excel type épuré avec juste ce qu'il faut de donnée. Je veux bien un coup de main sur le compteur du coup s'il te plaît :)

Code:

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
74
75
76
77
78
79
80
 
Option Explicit
 
Public adresse As String
Public poste As String
Public NomAppareil As String
Public ReferenceApp As String
Public JourRestant As Integer
 
Private Sub Application_Startup()
 
'   Nécessite de cocher la référence suivante :   Microsoft ActiveX Data Objects x.x Library
 
    Dim Cn As ADODB.Connection, Rst As ADODB.Recordset
    Dim Fichier As String, NomFeuille As String, texte_SQL As String
    Dim Datas As Variant, i As Long
 
    'Définit le classeur fermé servant de base de données
    Const NOMFICHIER As String = "Moyen étalonnage2.xlsx"
    'NomUser à remplacer
    Fichier = "C:\Users\" & Environ("NomUser") & "\Desktop\" & NOMFICHIER
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Feuil1"
 
    Set Cn = New ADODB.Connection
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête
    texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
    'Ecrit le résultat de la requête dans le Variant Datas
    If Not Rst.EOF Then
        Datas = Rst.GetRows
    Else
        MsgBox "erreur d'importation"
    End If
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
    Set Rst = Nothing
 
    'Boucle sur les valeurs de la colonne 7
        For i = 0 To UBound(Datas)
            If Datas(6, i) <= 30 Then
                adresse = Datas(9, i) 'email dans la "colonne 10" de la variable tableau
                poste = Datas(0, i) 'poste d'utilisation dans la "colonne 1" de la variable tableau
                NomAppareil = Datas(1, i) 'type d'appareil dans la "colonne 2" de la variable tableau
                ReferenceApp = Datas(2, i) 'ref de l'appareil dans la "colonne 3" de la variable tableau
                JourRestant = Datas(6, i) 'nb de jour dans la "colonne 7" de la variable tableau
                Call EnvoiMail
            End If
        Next i
 
End Sub
 
Sub EnvoiMail()
 
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
 
objMsg.Importance = olImportanceHigh
objMsg.To = adresse & ""
objMsg.Subject = "Appareil à étalonner"
objMsg.Body = "Bonjour," & Chr(13) & Chr(13) & "Attention : il ne reste que " & JourRestant & " pour étalonner la " & NomAppareil & " référencée : " & RefAppareil & " (utilisée sur le poste : " & poste & " )" & Chr(13)
objMsg.Display 'Display affiche; .send pour envoi sans relecture
 
Set objMsg = Nothing
 
End Sub

Pièce jointe 575194

Quelque chose de ce type ?

Code:

1
2
3
4
5
6
7
 
    Variable = "SELECT K1' FROM [" & NomFeuille & "$]"
 
          If Variable = Date Then Exit Sub
          Else 
               'procédure
          End If

17/07/2020, 13h45
pijaku

La façon dont les données sont ordonnées dans la feuille ne permet pas de tout importer grâce à la méthode ADODB.

Il te faut, pour plus de facilité, ouvrir et fermer le classeur par macro.
L'utilisateur ne se rendra compte de rien, ce sera totalement invisible pour lui.

Ok avec ça?
17/07/2020, 13h59
Thumb down

Bonjour,
Personnellement j'aurais opté pour un fichier vbscript exécuter par le gestionnaire de tâche de Windows !
17/07/2020, 14h15
ycære

@Pijaku
Si c'est totalement invisible oui ca me va!
Après sur le principe pourquoi ça ne marche pas avec cette méthode ? S'il le faut on peut imaginer ordonner les données autrement ?

@Thumb down
Je n'ai rien contre mais ça dépasse mes compétences actuelles :D
17/07/2020, 14h20
pijaku

Citation:

S'il le faut on peut imaginer ordonner les données autrement ?

Pas de ligne vide, pas de colonne vide...
C'est tout.
Donc, déjà, ça va bloquer pour la ligne 1...
17/07/2020, 14h42
ycære

Ah! Donc pas de soucis tout est bien plein, j'ai simplement vidé et simplifié le fichier au max pour la confidentialité et la simplicité de lecture des données principales.
Le haut de la feuille fusionné ne peut pas représenter une gêne pour la création du tableau de la requête ?
17/07/2020, 14h45
pijaku

Je ne sais pas, ne pouvant pas tester.
Par contre, la date en K1 n'est pas importée car colonne K non remplie...

Donc, non ADODB ne fonctionne pas.
17/07/2020, 14h47
ycære

Je vais refaire un fichier test. Je publie ca au plus vite.

A tester :

Code:

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
Option Explicit
 
Private Sub Application_Startup()
    Dim appE As Excel.Application, wbk As Workbook, wsh As Worksheet
    Dim Fichier As String, NomFeuille As String
    Dim Datas As Variant, i As Long, DL As Long
    Dim adresse As String, poste As String, NomAppareil As String, ReferenceApp As String, JourRestant As Integer
 
    Const NOMFICHIER As String = "Moyen étalonnage2.xlsx"
    Fichier = "C:\Users\" & Environ("username") & "\Desktop\" & NOMFICHIER
    NomFeuille = "Feuil1"
 
    'Ouverture application excel (invisible) + classeur
    Set appE = New Excel.Application
    appE.Visible = False
    Set wbk = appE.Workbooks.Open(Fichier)
    Set wsh = wbk.Sheets(NomFeuille)
 
    With wsh
        DL = derlig_reelle(.Columns(1))
        'Extraction des données
        Datas = .Range("A1:K" & DL).Value
    End With
 
 
    'Traitement
    If Datas(2, 11) <> Date Then
    'Boucle sur les valeurs de la colonne 7
        For i = 0 To UBound(Datas)
            If Datas(i, 6) <= 30 Then
                adresse = Datas(i, 9) 'email dans la "colonne 10" de la variable tableau
                poste = Datas(i, 0) 'poste d'utilisation dans la "colonne 1" de la variable tableau
                NomAppareil = Datas(i, 1) 'type d'appareil dans la "colonne 2" de la variable tableau
                ReferenceApp = Datas(i, 2) 'ref de l'appareil dans la "colonne 3" de la variable tableau
                JourRestant = Datas(i, 6) 'nb de jour dans la "colonne 7" de la variable tableau
                Call EnvoiMail(adresse, poste, NomAppareil, ReferenceApp, JourRestant)
            End If
        Next i
    End If
    wsh.Range("K2").Value = Date
    'fermeture classeur + application
    wbk.Close True
    appE.Quit
    Set wsh = Nothing
    Set wbk = Nothing
    Set appE = Nothing
End Sub
 
Private Sub EnvoiMail(adresse As String, poste As String, NomAppareil As String, ReferenceApp As String, JourRestant As Integer)
Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)
    objMsg.Importance = olImportanceHigh
    objMsg.To = adresse & ""
    objMsg.Subject = "Appareil à étalonner"
    objMsg.Body = "Bonjour," & Chr(13) & Chr(13) & "Attention : il ne reste que " & JourRestant & " pour étalonner la " & NomAppareil & " référencée : " & RefAppareil & " (utilisée sur le poste : " & poste & " )" & Chr(13)
    objMsg.Display 'Display affiche; .send pour envoi sans relecture
    Set objMsg = Nothing
End Sub
Private Function derlig_reelle(Plage As Range) As Long
   If WorksheetFunction.CountA(Plage) = 0 Then derlig_reelle = Plage.Cells(1, 1).Row: Exit Function
   derlig_reelle = Plage.Find("*", , , , , xlPrevious).Row
End Function

20/07/2020, 08h51
ycære

1 pièce(s) jointe(s)

Bonjour,

J'ai fait le test avec ce code mais rien ne se produit au démarrage d'outlook après insertion du code dans "ThisOutlookSession". J'ai également fait le test en remplaçant "username" par mon username, idem, pas d'effet. Pour le test j'avais ajouté mon email dans les cellules de la colonne destinée à cet effet. :?

Voici une version d'un fichier test avec toute les cellules non-vides : Pièce jointe 575400

Bonjour,

Il faudrait que tu mettes un peu les mains à la pâte, pour débugger cette partie du code :

Code:

1
2
3
4
5
6
7
        For i = 0 To UBound(Datas)
            If Datas(i, 6) <= 30 Then
                adresse = Datas(i, 9) 'email dans la "colonne 10" de la variable tableau
                poste = Datas(i, 0) 'poste d'utilisation dans la "colonne 1" de la variable tableau
                NomAppareil = Datas(i, 1) 'type d'appareil dans la "colonne 2" de la variable tableau
                ReferenceApp = Datas(i, 2) 'ref de l'appareil dans la "colonne 3" de la variable tableau
                JourRestant = Datas(i, 6) 'nb de jour dans la "colonne 7" de la variable tableau

Il faut que tu adaptes les colonnes et la boucle, un peu comme ceci :

Code:

1
2
3
4
5
6
7
8
 
        For i = LBound(Datas) + 3 To UBound(Datas)
            If Datas(i, 7) <= 30 Then
                adresse = Datas(i, 10) 'email dans la "colonne 10" de la variable tableau
                poste = Datas(i, 1) 'poste d'utilisation dans la "colonne 1" de la variable tableau
                NomAppareil = Datas(i, 2) 'type d'appareil dans la "colonne 2" de la variable tableau
                ReferenceApp = Datas(i, 3) 'ref de l'appareil dans la "colonne 3" de la variable tableau
                JourRestant = Datas(i, 7) 'nb de jour dans la "colonne 7" de la variable tableau

Voir 40 message(s) de cette discussion en une page