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
| Private Function ReadTxtFile(txtFile As String) As String
'This function returns the whole content of a text file as one string.
Dim fso As Object
Dim f As Object
Const ForReading As Integer = 1
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.OpenTextFile(txtFile, ForReading)
On Error GoTo 0
If f Is Nothing Then Err.Raise vbObjectError + 10001, , "File " & txtFile & " could not be found."
'If empty file, an error is raised; continue
On Error Resume Next
ReadTxtFile = f.ReadAll
f.Close
End Function
Private Sub WriteTxtFile(txtFile As String, txt As String, Optional overwriteWithoutWarning As Boolean = False, Optional append As Boolean = False)
'This function enables to replace the content of a text file by the string parameter 'txt'.
'The file is created if it does not exist.
Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0
Dim fs0, f As Object
Dim userChoice As Integer
'Ask for overwriting to user if necessary
If Not append And Not overwriteWithoutWarning And Dir(txtFile) <> "" Then
userChoice = MsgBox("File """ & VBA.Right(txtFile, VBA.Len(txtFile) - VBA.InStrRev(txtFile, "\")) & """ already exists in folder """ & VBA.Left(txtFile, VBA.InStrRev(txtFile, "\") - 1) & """; do you want to overwrite it?", vbYesNo)
Else
userChoice = vbYes
End If
If userChoice <> vbYes Then Err.Raise vbObjectError + 10001, , "User refused to overwrite file """ & txtFile & """."
Set fs0 = CreateObject("Scripting.FileSystemObject")
Set f = fs0.OpenTextFile(txtFile, IIf(append, ForAppending, ForWriting), True, TristateFalse)
f.write txt
f.Close
End Sub |
Réaliser une automatisation avec "recherche et remplacer"
Répondre avec citation
si les messages vous aide ou sont pertinents et de mettre 
quand cela est !
Partager