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