Erreur d'exécution 3049 [Résolu]

[fredvic]

Bonjour à tous,

Je résume mon problème:

Je veux importer plusieurs milliers de fichier texte dans une table, avec pour chacun le nom du fichier dans une colonne et le contenu dans une autre (memo).

Voici le code que j'utilise:

Code :

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
 
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim oFld As Folder
Dim oFldMonth As Folder
Dim oFldDay As Folder
Dim TotalFolder1 As Integer
Dim TotalFolder2 As Integer
Dim TotalFile As Integer
Dim Folder1Count As Integer
Dim Folder2Count As Integer
Dim FileCount As Integer
 
Folder1Count = 0
Folder2Count = 0
FileCount = 0
 
'DoCmd.OpenForm "ProgressBarForm"
 
Forms!ProgressBarForm!ProgressBar1.Value = 0
Forms!ProgressBarForm!ProgressBar3.Value = 0
Forms!ProgressBarForm!ProgressBar4.Value = 0
 
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
'Accède au dossier
Set oFld = oFSO.GetFolder("E:\Factures 2010\")
 
Set db = CurrentDb
Set rs = db.OpenRecordset("InvoiceLoad")
 
For Each oFldMonth In oFld.SubFolders
    TotalFolder1 = oFld.SubFolders.Count
    For Each oFldDay In oFldMonth.SubFolders
        TotalFolder2 = oFldMonth.SubFolders.Count
        TotalFile = oFldDay.Files.Count
        For Each oF1 In oFldDay.Files
            Set oTxt = oF1.OpenAsTextStream(ForReading)
            If Left(Right(oF1.Path, 5), 1) = "F" Then
                If Not oTxt.AtEndOfStream Then
                    rs.AddNew
                    rs!FileName = oF1.Path
                    rs!FileContent = oTxt.ReadAll
                    rs.Update
                Else
                    rs.AddNew
                    rs!FileName = oF1.Path
                    rs!FileContent = "File Problem"
                    rs.Update
                End If
            End If
            FileCount = FileCount + 1
            Forms!ProgressBarForm!ProgressBar1.Value = Round(FileCount / TotalFile * 100, 0)
            DoEvents
        Next
        FileCount = 0
        Folder2Count = Folder2Count + 1
        Forms!ProgressBarForm!ProgressBar3.Value = Round(Folder2Count / TotalFolder2 * 100, 0)
    Next
    Folder2Count = 0
    Folder1Count = Folder1Count + 1
    Forms!ProgressBarForm!ProgressBar4.Value = Round(Folder1Count / TotalFolder1 * 100, 0)
Next
 
MsgBox "Invoice load of " & oFld.Path & " Completed"
 
rs.Close
Set rs = Nothing
Set db = Nothing
 
End Sub

Le programme fonctionne bien pendant un certain temps, jusqu'à ce qu'il accroche sur un quelconque fichier et génère une erreur de type:

`Erreur d'exécution '3049':
Impossible d'ouvrir la base de données " ". Ce n'est peut-être pas une base de données que votre application reconnaît, ou le fichier est peut-être endommagé.

L'erreur est générée sur la ligne suivante:

Code :

1
2
 
 rs!FileContent = oTxt.ReadAll

J'ignore pourquoi, est-ce que vous avez une idée?

Merci d'avance pour votre aide.

[marot_r]

As-tu vérifié que tu ne satures pas ta base ?

Une base Access ne peut pas excéder 2 Go et quand tu y arrives, il se passe des choses bizares.

A+

[fredvic]

Oui effectivement, j'ai vérifié et la taille de la base dépasse un peu les deux gigs...

Je me demande comment contourner cette limite, il faudrait que je découpe mes fichiers sur plusieurs bases... Je ne vois pas autre chose, d'autres idées?

Merci!

[marot_r]

En effet tu peux découper ta base en plusieurs, chacune peut alors être de 2 Go au max.

Pourquoi as-tu besoin de charger tous ces fichiers textes ?

Ne pourrais-tu travailler ligne par ligne et extraire les info qui t'interessent au fur et à mesure ?

A+

[fredvic]

Chacun de ces fichiers représente une facture, c'est fou, j'en ai des centaines de milliers à traiter, j'ai besoin de tout, l'entête de la facture ainsi que les lignes de détails..

Suivant ceci, j'ai essayé d'ouvrir les fichiers au moyen d'un textstream et de séparer mes colonnes au moyen d'un split, par contre les séparateurs me donnent des problèmes. J'ai un fichier qui a l'allure suivante:

""TOTO", "12, rue BLABLA", "", 0.01"

quand je fais un Split avec un délimiteur "," sur la ligne j'obtiens:
"TOTO"
"12
rue BLABLA"
""
0.01

Alors que je voudrais avoir:
"TOTO"
"12, rue BLABLA"
""
0.01

Le problème étant que le split ne différencie pas le séparateur "," d'une virgule incluse à l'intérieur d'un champs.

Est-ce que vous voyez une solution?

Merci

[Orion34080]

Pour ton split,

Tu aurais peut être plus de succès avec ceci :
(si bien sûr chaque ligne est bien constituée ainsi que tu le décris : ""TOTO", "12, rue BLABLA", "", 0.01")

Code :

1
2
3
Ligne = Handle_F.readLine
Ligne = Mid(Ligne, 2)
Tableau = Split(Ligne, """, ", -1, 1)

Sachant que Ligne contient la lecture d'une ligne de ton fichier texte et Tableau les divers éléments qui le composent.

Bien sur, ensuite pour toutes les occurences de Tableau (de Tableau(0) à Tableau(n), il te faudra sons doute faire sauter les guillemets restants.

Michel

[fredvic]

Malheureusement, ça ne marche pas directement parce que les champs numériques peuvent se suivre dans le fichier sans être entrecoupé par un champs texte.

ex. ""TOTO", "12, rue BLABLA", "", 0.01, 123, 34, 0.45,"TATA""

En alternative, j'ai essayé d'importer les fichiers avec la commande DoCmd.TransferText avec des spec. d'importation comma delimited et double quote encased text, ça règle le problème des "" et des virgules, par contre je suis incapable de copier le nom du répertoire (Path) dans ma table et de plus une tonne de fichier d'erreur d'import sont automatiquement générés et ce malgré que tous les champs de ma table soit définie en texte (255)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
For Each oFldDay In oFld.SubFolders
    For Each OF1 In oFldDay.Files
        If Left(Right(OF1.Path, 5), 1) = "F" Then
            DoCmd.TransferText acImportDelim, "ImportInvoice", "InvoiceLoad", OF1.Path
            'Tentative de récupérer le nom du fichier et path qui ne fonctionne pas
            rs.Edit                      
            rs!FileName = OF1.Path
            rs.MoveNext
        End If
    Next
Next

Toute suggestion est appréciée, merci!

a+

[Orion34080]

En fait, j'avais basé ma réponse sur la ligne que tu nous avais donnée en exemple initialement :

""TOTO", "12, rue BLABLA", "", 0.01")

et non sur la ligne que tu présentes maintenant à savoir :

""TOTO", "12, rue BLABLA", "", 0.01, 123, 34, 0.45,"TATA""

Est-ce bien la structure de chacune de tes lignes où y-a-t-il d'autres structures dans ce fichier texte ?
Donc : "Texte,Texte,Texte,NB,NB,NB,NB,Texte" ?

Sur cette base, il serait possible d'écrire :

Code :

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
Sub test()
Dim Resultat(7)
 
'   ""TOTO", "12, rue BLABLA", "", 0.01, 123, 34, 0.45,"TATA""
 
Nom_fichier = "C:\Documents and Settings\Bureau\test.txt"
 
Set filesys = CreateObject("Scripting.FilesystemObject")
Set Handle = filesys.opentextfile(Nom_fichier, 1, False) 'fichier en entrée
 
Ligne = Handle.readLine
 
Tableau = Split(Ligne, """, ", -1, 1)
 
Resultat(0) = Tableau(0)
Resultat(1) = Tableau(1)
Resultat(2) = Tableau(2)
 
Tableau = Split(Tableau(3), ",", -1, 1)
Resultat(3) = Tableau(0)
Resultat(4) = Tableau(1)
Resultat(5) = Tableau(2)
Resultat(6) = Tableau(3)
Resultat(7) = Tableau(4)
 
For I = 0 To 7
    Resultat(I) = Replace(Resultat(I), Chr$(34), "")
Next I
 
End Sub

Cela donnerait pour résultats :
Résultat(0)="TOTO"
Résultat(1)="12, rue BLABLA"
Résultat(2)=""
Résultat(3)="0.01"
etc.
Resultat(7)="TATA"

Pourquoi faire simple quand JE peux faire compliqué

Michel

[fredvic]

Bonjour Orion, non ce n'était qu'un exemple simplifié, pour la structure complète du fichier voir le texte suivant, pour un total de 90 colonnes à gérer. J'ai remplacé certain caractère par des X pour préserver la confidentialité des informations.

Merci

"F","522XXX","0000","DURXX1","REPARATION DE XXXXX DURXXXX","","2XX VXXXEE","STE XXNE DE BXXX QC","H1H 0X0","514/4XX-XXXX","","","JXXX FXXXX","","","","ATEXXXX","DXR","","","","","000/000-0000","","XX/08/2010","15.52","XX/08/2010","6.32",1.00,.00,.00,.00,"522XXX","","491XXX","","",62.00,.00,4.90,.00,.00,.00,.00,"66.9",3.35,5.27,.00,75.52,.00,75.52,"","OX /GE",.00,"","","","","P15X-","",.00,.00,"","","","","","","",.00,"7.9","DOR","","","","","","","500XXX","","F","O","Q","","XX/08/2010","",.00,"",.00,""

[fredvic]

Je vais tester cette solution et je te reviens plus tard

[marot_r]

Si ta structure est constante, tu peux aussi regarder la vielle instruction Read, combinée à Open NomFic as #NumFic for Input et Close #NumFic, qui permet de lire des fichiers textes séquentiellement donc un enregistrement à la fois.

A+

[fredvic]

Bonjour à tous,

Pour conclure ce fil, j'ai créé une nouvelle version de la fonction split qui tient compte des délimiteurs de texte. Cette fonction manipule une variable globale.
Pour résumer;

- lecture d'une ligne du fichier
- Appel de la fonction SplitDelimText avec la ligne du fichier en argument
- Écriture du résultat retourné colonne par colonne à partir du tableau StrTab() et d'un recordset collection fields.

Voici le code de ma fonction Split, au cas où quelqu'un serait intéressé:

Code :

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
 
Public StrTab() As String
 
Function SplitDelimText(strToSplit As String)
 
Dim CharTab() As String
Dim i As Integer
Dim j As Integer
Dim xpos As Integer
Dim OpenQuote As Boolean
 
OpenQuote = False
j = 0
xpos = 0
ReDim CharTab(Len(strToSplit))
 
For i = 0 To Len(strToSplit)
    CharTab(i) = Mid(strToSplit, i + 1, 1)
    If i = Len(strToSplit) Then
        StrTab(j) = Mid(strToSplit, xpos + 1, Len(strToSplit))
        Exit Function
    End If
 
    Select Case CharTab(i)
 
        Case ",":
            If OpenQuote = False Then
                ReDim Preserve StrTab(j + 1)
                StrTab(j) = Mid(strToSplit, xpos + 1, i - xpos)
                xpos = i + 1
                j = j + 1           
            End If
 
        Case """":
            If OpenQuote = False Then
                OpenQuote = True
            Else: OpenQuote = False
            End If
        End Select
 
Next i
 
End Function

A+