Export table access>65536 lignes vers Excel [Résolu/Fermé]

Signaler
Messages postés
19
Date d'inscription
mercredi 27 septembre 2006
Statut
Membre
Dernière intervention
5 octobre 2010
-
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
-
Bonjour,

J'ai une table access de plus de 65536 enregistrements que je voudrais exporter vers Excel. Comment faire pour exporter dans autant de fichiers Excel qu'il y a de fois 65536 lignes ? J'aimerais faire une macro.

Merci

11 réponses

Voilà...
https://support.microsoft.com/en-us/help/120596

Donc : Office 2007 ou

Le code de la macro :

Sub LargeFileImport()

'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
'Ask User for File's Name
FileName = InputBox("Please enter the Text File's name, e.g. test.txt")
'Check for no entry
If FileName = "" Then End
'Get Next Available File Handle Number
FileNum = FreeFile()
'Open Text File For Input
Open FileName For Input As #FileNum
'Turn Screen Updating Off
Application.ScreenUpdating = False
'Create A New WorkBook With One Worksheet In It
Workbooks.Add template:=xlWorksheet
'Set The Counter to 1
Counter = 1
'Loop Until the End Of File Is Reached
Do While Seek(FileNum) <= LOF(FileNum)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
'Store One Line Of Text From File To Variable
Line Input #FileNum, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 65536 Then
'If On The Last Row Then Add A New Sheet
ActiveWorkbook.Sheets.Add
Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False

End Sub
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60511 internautes nous ont dit merci ce mois-ci

Mec..... pourquoi t'irais pas t'allonger un peu et prendre le soleil plutot? C'est quoi ces histoires serieux? peace..... repose toi.
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
3
Merci Groggy. En fait j'avais essayé ce code mais une erreur se produit à la ligne
If Left( ResultStr, 1) = "=" Then
Et je ne sais pas ce que signifie cette ligne.
Merci encore.
Messages postés
23555
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
11 octobre 2020
6 400
Bonjour,

peut-être as-tu des lignes vides...
Essaie en remplaçant par :
if len(ResultStr)=0 then</gras>
elseIf Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

eric
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
3
Merci pour la réponse. J'ai essayé mais l'erreur se produit toujours au niveau de la fonction Left (du code que tu as bien voulu me proposer).
Par ailleurs, je n'ai aucune ligne vide normalement. Je me demande si ce n'est pas le type de séparation (dans le txt qui dérange). Des tabulations (espace) délimitent les champs. C'est-à-dire en important dans Excel (les fichiers plus petits) avec l'assistant, je choisis "Délimité" puis je coche Tabulation , Espace.
J'avoue que je ne comprends pas bien cette ligne du code: If Left(ResultStr, 1) = "=" Then.
Merci.
Messages postés
23555
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
11 octobre 2020
6 400
If Left(ResultStr, 1) = "="
regarde si la ligne commence par le caractère =, si oui ajoute le caractère ' devant pour qu'excel ne l'interprete pas comme une formule.
Il faudrait déposer un extrait de ton fichier (avec la ligne de données ou l'erreur se produit) sur cijoint.fr et coller le lien ici
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
3
J'ai déposé mon fichier entier à l'adresse: http://dl.free.fr/getfile.pl?file=/Ngx9RJTO

Tu écris: "avec la ligne de données ou l'erreur se produit". En fait, lorsque je lance l'exécution, j'ai le message "Erreur de compilation. Projet ou bibliothèque introuvable." Le curseur s'arrête sur la fonction "Left".

Merci.
Messages postés
23555
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
11 octobre 2020
6 400
Impossible à telecharger.
Allege ton fichier et utilise cijoint.fr
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
3
J'ai pu résoudre le problème de "Erreur de compilation. Projet ou bibliothèque introuvable." grâce à l'aide en ligne de microsoft. Maintenant, le code me donne un fichier Excel dans lequel se trouve toutes les données. Seulement, les données de chaque ligne sont toutes dans une colonne.
Je joins le fichier xls (réduit, mais tu pourras voir ce que ça donne) et le fichier texte (réduit aussi).

Le fichier http://www.cijoint.fr/cjlink.php?file=cj200912/cijgOxsJRA.xls
Le fichier texte (allégé) est à l'adresse: http://www.cijoint.fr/cjlink.php?file=cj200912/cijYGBweQf.txt

Merci.
Salut,

Seulement, les données de chaque ligne sont toutes dans une colonne.

C'est normal. La solution proposé sur le site de microsoft ne traite pas le séparateur.
La variable ResultStr contiendra la ligne entière.
Il faudra utiliser par exemple la fonction split en fonction de séparateur.
Re,

Essaie avec ça.
Donc tu ouvres un classeur vide et tu lances la macro.
J'ai fait sur 65000 lignes au lieu de 2^16 lignes

Option Explicit
Sub insertion()
    Dim i As Long, j As Long, r As Long
    Dim idxT As Integer
    Dim ligne As String
    Dim t
    i = 0
    j = 1
    r = 1
    
    Open "D:\fic.txt" For Input As #1
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets.Add.Move after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "feuille" & j
    Do While Not EOF(1)
        i = i + 1
        Line Input #1, ligne
        If i Mod 65000 = 0 Then
            ActiveWorkbook.Save
            r = 1
            j = j + 1
            ActiveWorkbook.Sheets.Add.Move after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = "feuille" & j
        End If
        t = Split(ligne, " ")
        Debug.Print j
        For idxT = 0 To UBound(t)
            Sheets("feuille" & j).Cells(r, idxT + 1) = t(idxT)
        Next idxT
        r = r + 1
        
    Loop
    Application.ScreenUpdating = True
    Close #1
    MsgBox "Traitement terminé", vbInformation
        
End Sub
Messages postés
23
Date d'inscription
mercredi 29 avril 2009
Statut
Membre
Dernière intervention
12 décembre 2009
3
J'ai fini par comprendre le code de microsoft!
Merci beaucoup pour ton code: c'est du tonnerre et c'est propre. Je suis plus que satisfait car ça marche à merveille. Merci encore et merci aussi à eriiic.