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
| Private Sub ExportData()
'Declarations
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim XLapp As New Excel.Application
Dim XLBook As Excel.Workbook
Dim XLSheet As Object
Dim XLSheet_2 As Object
'J'envoie le contenu de mes tables dans des recordsets
Set db = CurrentDb
Set rst1 = db.OpenRecordset("SELECT * FROM [Table1]")
Set rst2 = db.OpenRecordset("SELECT * FROM [Table2]")
Set XLBook = XLapp.Workbooks.Open("C:\DATA\161381\Report Automation\Xstrata_Dinoob\Xstrata_Dinoob.xlsm")
'Si les tables existent déja dans le fichier Excel, je les supprime et j'en créée des nouvelles
'Si les tables n'existent pas, j'en créée des nouvelles
'La première table
If XLSheet Is Nothing Then
Set XLSheet = XLBook.Worksheets.Add
XLSheet.Name = "Feuille1"
Else: XLBook.Worksheets("Feuille1").Delete
Set XLSheet = XLBook.Worksheets.Add
XLSheet.Name = "Feuille1"
End If
Dim col As Integer
XLSheet.Select
XLSheet.Range("A:A").EntireRow.Delete
For col = 0 To rst1.Fields.Count - 1
XLSheet.Cells(1, col + 1) = rst1.Fields(col).Name
Next col
XLSheet.Range("A2").CopyFromRecordset rst1
'La deuxième table
If XLSheet_2 Is Nothing Then
Set XLSheet_2 = XLBook.Sheets.Add
XLSheet_2.Name = "Feuille2"
Else: XLSheet_2.Delete
Set XLSheet_2 = XLBook.Sheets.Add
XLSheet_2.Name = "Feuille2"
End If
Dim col_1 As Integer
XLSheet_2.Select
XLSheet_2.Range("A:A").EntireRow.Delete
For col_1 = 0 To rst2.Fields.Count - 1
XLSheet_2.Cells(1, col_1 + 1) = rst2.Fields(col_1).Name
Next col_1
XLSheet_2.Range("A2").CopyFromRecordset rst2
XLapp.Visible = True
XLBook.Windows(1).Visible = True
rst1.Close
rst2.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set XLapp = Nothing
Set XLBook = Nothing
Set XLSheet = Nothing
Set XLSheet_2 = Nothing
End
End Sub |
Partager