Discussion :

[ted the Ors]

Bonjour,

J'utilise le code ci-dessous pour insérer des séparateurs dans des fichiers txt (dont la taille oscille entre 1 Mo et 1,5 Go).

J'obtiens une erreur 14, Espace de chaîne insuffisant (Visual Basic) au niveau de l'instruction en gras.

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
Sub ReplaceLineFromFileByPattern()
    
    Dim f As Integer, errCode As Integer, errString As String
    Dim buffer As String
    Dim t() As String
    Dim i As Long
    Dim nbOcc As Long
    Dim j As String
    Range("B2") = Date & " à " & Time
    FileName = "C:\MonFichier.txt"
    buffer = ReadFileToBuffer(FileName, errCode, errString)
If erreur_lect = 1 Then
    lastline = Range("C1").End(xlDown).Row
    MsgBox lastline
    t() = Split(buffer, vbCrLf)
    f = FreeFile
    Open FileName For Output As #f
    MsgBox UBound(t())

        For i = 0 To UBound(t())
            j = Chr(34) & Mid(t(i), Range("C" & 2), Range("D" & 2))
            long_lue = Range("C" & 2)
            For k = 3 To lastline
                long_lue = long_lue + Range("C" & k)
                If k = lastline Then
                    j = j & Chr(34) & ";" & Chr(34) & Mid(t(i), Range("C" & k), Range("D" & k)) & Chr(34)
                Else
                    j = j & Chr(34) & ";" & Chr(34) & Mid(t(i), Range("C" & k), Range("D" & k))
                End If
            Next k
            Print #f, j
        Next i
    Close #f
    Range("B3") = Date & " à " & Time
Else
    MsgBox "Erreur lecture fichier:" & errCode & ":" & errString
End If
End Sub

Private Function ReadFileToBuffer(ByVal szFileName As String, _
                                ByRef errCode As Integer, _
                                ByRef errString As String) As String
    Dim f As Integer
    Dim buffer As String
    erreur_lect = 0
    ' trappe les erreurs
    On Error GoTo ReadFileToBuffer_ERR

    ' Ouverture du fichier en 'Binary'
    f = FreeFile
    'MsgBox f
    Open szFileName For Binary As #f
        ' préallocation d'un buffer à la taille du fichier
        buffer = Space$(LOF(f))
        ' lecture complète du fichier
        Get #f, , buffer
    Close #f
    ReadFileToBuffer = buffer
ReadFileToBuffer_END:
    Exit Function
    'Close #f
ReadFileToBuffer_ERR:
    ' Gestion d'erreur
    ReadFileToBuffer = ""
    errCode = err.Number
    errString = err.Description
    erreur_lect = 1
    Close #f
    Resume ReadFileToBuffer_END
End Function

Que faire?

D'avance merci.

[ted the Ors]

Bon a priori, il s'agit d'une erreur lors de la prise en charge des très grands fichiers
Vu sur le net:

Pour les très gros fichiers (plusieurs centaines de mégaoctets), l'allocation par Space$() peut poser problème : limite de taille, performances. Pour ces cas particuliers, on pourra se tourner vers l'utilisation d'une technique extrêmement performante : Le File Mapping. La description de cette technique dépasse nettement le cadre de cet article, mais la documentation Microsoft sur le sujet est bien faite. Des exemples sont disponibles à partir de ce lien : CreateFileMapping.

Le lien mène vers http://msdn.microsoft.com/en-us/libr...8VS.85%29.aspx
Mais je n'y comprends pas grand chose...