Exportation de données Access dans Excel, et envoi par e-mail

Soit une base de données Access avec une seule table : T_Client. Il s'agit de créer un fichier Excel avec le contenu des données d'un seul client, et d'envoyer le fichier résultant via Outlook.

Programmeurs avertis uniquement

La base de données contenant cet exemple est télécheargeable ici.

Il y a une seule table : T_Client, contenant 4 champs : IDClient, NomClient, Prenom et Ville

Le formulaire F_Base n'est basé sur aucune table, il contient une liste de choix basée sur T_Client, contenant tous les champs sauf la ville.

Pour faire fonctionner l'exemple, il s'agit de lancer F_Base, choisir un client en cliquant dessus, et cliquer sur le bouton en dessous. Ca aura pour résultat de préparer un e-mail avec comme pièce attachée un fichier Excel contenant les données du client choisi. Essayez... Vous risquez de voir apparaître un message d'Outlook vous prévenant "qu'un programme tente d'envoyer un message en votre nom", il faut accepter, car le programme en question, c'est justement celui ci.

Une fois la manoeuvre effectuée, dans Outlook, dans la "Boîte d'envoi", votre e-mail est prêt à partir, pourvu du fichier Excel joint.

Si vous allez dans le formulaire F_Base en mode création, et que vous allez voir "Sur Click" du bouton, vous verrez ce code :

Private Sub BDCEnvoiExcel_Click()
  Dim TableClient As Recordset
  Set TableClient = CurrentDb.OpenRecordset("T_Client", dbOpenDynaset)
  TableClient.FindFirst ("IDClient = " & LISClient)
  Dim MonExcel As Object
  Set MonExcel = New Excel.Application
  MonExcel.Workbooks.Add
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A1").Value = "Nom :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A2").Value = "Prénom :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A3").Value = "Ville :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B1").Value = TableClient("NomClient")
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B2").Value = TableClient("Prenom")
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B3").Value = TableClient("Ville")
  On Error Resume Next
  Kill "C:\resultat.xls"
  On Error GoTo 0
  MonExcel.ActiveWorkbook.SaveAs "C:\resultat.xls"
  MonExcel.ActiveWorkbook.Close
  Set MonExcel = Nothing
  TableClient.Close
  Set TableClient = Nothing
  ' ENVOI PAR E-MAIL DU FICHIER :
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)
  MonMessage.to = "marcel@machin.com;julien@chose.com"
  MonMessage.cc = "chef@machin.com;directeur@chose.com"
  MonMessage.bcc = "un.copain@supermail.com;une-amie@hotmail.com"
  MonMessage.Attachments.Add "C:\resultat.xls"
  MonMessage.Subject = "Je suis content"
  Corps = "Bonjour,"
  Corps = Corps & Chr(13) & Chr(10)
  Corps = Corps & "Voici le fichier convenu."
  MonMessage.body = Corps
  MonMessage.send
  Set MonOutlook = Nothing
End Sub

Si vous vous inspirez de ce code, pensez, dans l'environnement VBA, a aller dans le menu Outils/Références, et cochez :

Analysons ce code :

On initialise DAO, c'est à dire Data Access Objects, soit ce qui permet d'accéder aux tables facilement par programmation

  Dim TableClient As Recordset
  Set TableClient = CurrentDb.OpenRecordset("T_Client", dbOpenDynaset)

On recherche dans la table le client correspondant au client chosi dans la liste :

  TableClient.FindFirst ("IDClient = " & LISClient)

Maintenant, on "ouvre" Excel, avec un classeur vide (add):

  Dim MonExcel As Object
  Set MonExcel = New Excel.Application
  MonExcel.Workbooks.Add

Dans différentes cellules de ce classeur, on écrit soit lées libellés (Nom :), et les contenus des champs correspondants dans la table, sur le client sélectionné :

  MonExcel.ActiveWorkbook.ActiveSheet.Range("A1").Value = "Nom :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A2").Value = "Prénom :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A3").Value = "Ville :"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B1").Value = TableClient("NomClient")
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B2").Value = TableClient("Prenom")
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B3").Value = TableClient("Ville")

On efface le fichier C:\resultat.xls, et s'il n'existait pas, on ne l'efface pas, mais il n'y a pas d'erreur grâce à ON ERROR RESUME NEXT :

  On Error Resume Next
  Kill "C:\resultat.xls"
  On Error GoTo 0

On enregistre ce fichier sous resultat.xls, et on ferme complètement Excel, ainsi que la table ouverte par DAO :

  MonExcel.ActiveWorkbook.SaveAs "C:\resultat.xls"
  MonExcel.ActiveWorkbook.Close
  Set MonExcel = Nothing
  TableClient.Close
  Set TableClient = Nothing

Ou ouvre Outlook, et on crée un nouveau message :

  ' ENVOI PAR E-MAIL DU FICHIER :
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)

On précise à qui le mail est envoyé, ainsi que l'attachement du fichier Excel, et le corps et le sujet du message ::

  MonMessage.to = "marcel@machin.com;julien@chose.com"
  MonMessage.cc = "chef@machin.com;directeur@chose.com"
  MonMessage.bcc = "un.copain@supermail.com;une-amie@hotmail.com"
  MonMessage.Attachments.Add "C:\resultat.xls"
  MonMessage.Subject = "Je suis content"
  Corps = "Bonjour,"
  Corps = Corps & Chr(13) & Chr(10) ' Retour chariot
  Corps = Corps & "Voici le fichier convenu."
  MonMessage.body = Corps

On envoie le message, c'est à dire qu'on le place dans "Boîte d'envoi". C'est à cet instant précis qu'Outlook peut vous donner le message : "Attention : un programme tente d'envoser un message en votre nom" :

  MonMessage.send

On "ferme" Outlook :

  Set MonOutlook = Nothing