Bonjour,

je dois exporter des données à plats depuis une base vielle base Oracle version 7 sur laquelle je me connecte depuis ACCESS 97 via ODBC.
nous avons choisi comme format d'extraction Excel (donc EXCEL 97 dans mon cas) pour que les utilisateurs puissent faire des recherches dans les données avec de simples filtres Excel.

j'ai donc écrit du code VBA pour exporter ces données
le principe est assez simple mais la mise en œuvre est pour le moins compliquée vu les limitations d'excel 97 (et probablement mon code)
je boucle sur mes données pour les exporter dans des feuilles excel par paquets de 65 534 lignes qui est la limitation d'excel 97

j'ai lancé mon programme sur un export de 1 926 643 enregistrements qui doivent s'écrire dans 30 feuilles excel donc à priori étant donné les limites d'excel 97 ce devrait passer

mais mon export s'effectue correctement jusqu'au 15 premières feuilles puis crash sur l'enregistrement 1 048 513 (ligne 65505,colonne 1 de la feuille 16) avec l'erreur suivante (msgbox) :
Excel mémoire insuffisante
et mon code s'arrête à la ligne 121 du code ci-dessous

j'ai regardé l'enregistrement en question et il n'y a pas de souci particulier dessus, je l'ai exporté seul et çà fonctionne
je ne comprends vraiment pas d'où vient le problème

je sais que plus personne n'utilise Access et Excel 97 mais je n'ai pas le choix
d'où peut provenir mon erreur ?

d'avance merci pour votre aide

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
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