Discussion :

[jbsushi]

Bonjour,
Comme précisé dans l'intitulé je souhaite exporter les donneés d'une de mes tables et faire un envoie de mail automatique.

Le code que j'ai réalisé peut actuellement, créer le document Excel en fonction de la mise en forme voulue et envoyer le mail automatiquement au destinataire avec le message voulu:

Le soucis que je rencontre est qu'il ne me remplis pas le tableau excel avec toutes les valeurs de ma table.

Pour être plus clair, voici ma table :


Et voici ce que le code me crée :


Le code ne remplis donc le tableau que de la première ligne issue de la table.
J'avais cru comprendre que :

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
74
75
76
77
78
79
 
Private Sub Commande71_Click()
Dim TableMarseille As Recordset
  Set TableMarseille = CurrentDb.OpenRecordset("T_marseille", dbOpenDynaset)
 
 
   'declaration des variables
  Dim MonExcel As Object
  Dim col As Integer
  Dim ligne As Integer
  Set MonExcel = New Excel.Application
 
  MonExcel.Workbooks.Add
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A1").Value = "Date du Dépannage"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B1").Value = "DIC"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("C1").Value = "Réference"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("D1").Value = "Dest"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("E1").Value = "Qté"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("F1").Value = "REP/BON"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("G1").Value = "Rep CRPR"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("H1").Value = "Coût du prêt"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("I1").Value = "Délai annoncé"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("J1").Value = "Prix journalier"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("K1").Value = "Date d'arret"
  MonExcel.ActiveWorkbook.ActiveSheet.Range("L1").Value = "Economie"
 
 
'Structure du tableau et ajout des titres sur la première ligne
  col = 1
  ligne = 1
 
  MonExcel.ActiveWorkbook.ActiveSheet.Range("A2").Value = TableMarseille("Date_Dep")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("B2").Value = TableMarseille("DIC")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("C2").Value = TableMarseille("Ref")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("D2").Value = TableMarseille("No_Dest")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("E2").Value = TableMarseille("Quantité")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("F2").Value = TableMarseille("REP_BON")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("G2").Value = TableMarseille("Rep_CRPR")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("H2").Value = TableMarseille("Coût_pret")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("I2").Value = TableMarseille("Délai_annoncé")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("J2").Value = TableMarseille("Prix_journalier")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("K2").Value = TableMarseille("Date_arret")
  col = col + 1
  MonExcel.ActiveWorkbook.ActiveSheet.Range("L2").Value = TableMarseille("Economie")
  col = col + 1
 
  On Error Resume Next
  Kill "D:\LocalData\a501895\Desktop\jb\test\resultat.xls"
  On Error GoTo 0
  MonExcel.ActiveWorkbook.SaveAs "D:\LocalData\a501895\Desktop\jb\test\resultat.xls"
  MonExcel.ActiveWorkbook.Close
  Set MonExcel = Nothing
 
  TableMarseille.Close
  Set TableMarseille = 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 = "Client@mail.com"
  MonMessage.Attachments.Add "D:\LocalData\a501895\Desktop\jb\test\resultat.xls"
  MonMessage.Subject = "Dépannage Marseille"
  MonMessage.Body = "Bonjour," & vbCrLf & "Comme d'habitude les dépannages Marseille" & vbCrLf & "Cordialement."
  MonMessage.Send
  Set MonOutlook = Nothing
End Sub

Cordialement,

Jbsushi