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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
Public Sub export(dms As String, requete As String, feuille As String, min As Long, max As Long, nombre As Long)
Dim db As DAO.Database
Set db = CurrentDb
Dim rs1, rs2, rs3 As Recordset
Dim dateExport As Date
Dim nomFichier, chemin, sql1, sql2, sel, nomColonne, dossier As String
Dim fso, appexcel, wbexcel As Object
Dim i, j, k, col As Integer 'i : ligne du fichier excel / j : nombre de colonnes / k : indice de colonne clause select
'date du jour
dateExport = Now()
'insertion des data à partir de la ligne 3 du fichier excel
i = 3
'chemin du dossier d'export
chemin = "C:\Documents and Settings\t2lecajer\Mes documents\exportXML\" & dms & "\"
'Script sql de la requête d'extraction des data
sql1 = requete & " WHERE ROWNUM>=" & min & " AND ROWNUM<=" & max
'Debug.Print "requete data : " & sql1
'clause select requete d'export -> récupération des nom de variables pour les en-tête de colonne du fichier d'export
sel = extraireNomVariable(CStr(sql1))
'Debug.Print "Select : " & sel
Set fso = CreateObject("Scripting.FileSystemObject")
Set appexcel = CreateObject("Excel.Application")
'création table temporaire pour stocker les libellés des variables extraites
Call creerTableTemporaireLibelle
'Ajout des libellés dans la table temporaire des libellés
For k = 0 To UBound(fSplit(CStr(sel), ","))
nomColonne = fSplit(CStr(sel), ",")(k)
'Debug.Print "nom colonne : " & nomColonne
Set rs3 = CurrentDb.OpenRecordset("TMP_LIB", DB_OPEN_DYNASET)
rs3.AddNew
rs3.Fields(1) = dms
If (InStr(1, nomColonne, "AS")) Then 'Traitement des 'Alias'
rs3.Fields(2) = Trim(fSplit(CStr(nomColonne), "AS")(1))
Else
rs3.Fields(2) = fSplit(CStr(nomColonne), ".")(1)
End If
rs3.Update
Next
Set rs1 = CurrentDb.OpenRecordset(sql1)
'Debug.Print rs1.Fields(0).Value & " " & rs1.Fields(1).Value & " " & rs1.Fields(2).Value & " " & rs1.Fields(3).Value & " " & rs1.Fields(4).Value & " " & rs1.Fields(5).Value & " " & rs1.Fields(6).Value & " " & rs1.Fields(7).Value
sql2 = "SELECT DISTINCT TMP_LIB.VAR_NOM, LIBELLES.VAR_LIB, TMP_LIB.TAB_NOM, TMP_LIB.ID " _
& "FROM TMP_LIB LEFT JOIN LIBELLES ON TMP_LIB.VAR_NOM = LIBELLES.VAR_NOM " _
& "WHERE TMP_LIB.TAB_NOM='" & dms & "' " _
& "ORDER BY TMP_LIB.ID;"
'Debug.Print "requete libellés : " & sql2
'récupération des libellés variables dans la table LIBELLES
Set rs2 = CurrentDb.OpenRecordset(sql2)
'nom du fichier
'nomFichier = dms & "_" & rs1.Fields(0).Value & "_" & Format(dateExport, "yyyymmdd")
nomFichier = dms & "_" & Format(dateExport, "yyyymmdd")
'création du dossier d'export
'test de l'existance du dossier avant de le créer
If Not fso.FolderExists(chemin) Then
'création du dossier d'archivage
dossier = fso.CreateFolder(chemin)
Else
dossier = chemin
End If
'ouvrir rapport excel
'Set wbexcel = appexcel.Workbooks.Open(dossier & "\" & nomFichier)
Set wbexcel = appexcel.Workbooks.Open(dossier & nomFichier)
'selection feuille
appexcel.Sheets("resume").Select
appexcel.Cells(1, 1) = "Export DMS " & dms
appexcel.Cells(2, 1) = "date export"
appexcel.Cells(2, 2) = dateExport
'selection feuille
'appexcel.Sheets("data").Select
appexcel.Sheets(feuille).Select
'en-tête des colones
col = 1
If Not rs2.EOF Then rs2.MoveFirst
Do While Not rs2.EOF
'Libellés variables
appexcel.Cells(1, col) = rs2.Fields(1).Value
'Noms variables
appexcel.Cells(2, col) = rs2.Fields(0).Value
rs2.MoveNext
col = col + 1
Loop
If Not rs1.EOF Then rs1.MoveFirst
Do While Not rs1.EOF
Debug.Print "Numéro enregistrement : " & rs1.Fields(0).Value & "-" & Now()
'insertion des data
For j = 1 To rs1.Fields.Count
If IsNull(rs1.Fields(j - 1).Value) Then
appexcel.Cells(i, j) = ""
ElseIf rs1.Fields(j - 1).Value Like "=*" Then
appexcel.Cells(i, j) = CStr(Right(CStr(rs1.Fields(j - 1).Value), Len(CStr(rs1.Fields(j - 1).Value)) - 1))
Else
appexcel.Cells(i, j) = CStr(rs1.Fields(j - 1).Value) '<- BUGG : i=65505 et j=1 / rs1.Fields(j - 1).Value=1048513
End If
Next
'incrémentation du numero de ligne
i = i + 1
rs1.MoveNext
Loop
rs1.Close
rs2.Close
wbexcel.Close True
Set wbexcel = Nothing
Set appexcel = Nothing
End Sub |
