Reads and saves text file giving its full name
Used a lot in my tools, very handy tool
ReadMethod ...
' =1, reads/saves using ADODB stream, used for UTF-8 Unicode files.
' =2, reads/saves using FileSystemObject, does not work with UTF-8
' =3, reads using 'Open+Input all bulk', Saves using 'Output'
' =4, reads using 'Open+Input line by line', saves using 'Append'
Edit: 2020-10-13: Adding ability to avoid error if file is 0 bytes length when reading
Function ASCII_Read(File2, Optional ReadMethod = 1)
' ReadMethod
' =1, read using ADODB stream, used for UTF-8 Unicode files.
' =2, reads using FileSystemObject, does not work with UTF-8
' =3, reads using 'Open+Input all bulk'
' =4, reads using 'Open+Input line by line'
'
Rett = ""
If ReadMethod = 1 Then ' ADODB
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile (File2)
Rett = objStream.ReadText()
objStream.Close
Set objStream = Nothing
ElseIf ReadMethod = 2 Then ' FSO
Dim Fso As Object, oFi As Object
Const ForReading = 1 ' 1 for reading, 8 for Appending
Const TristateTrue= 1 ' 0 for ASCII, 1 for Unicode, 2 for System default
Set Fso = CreateObject("Scripting.FileSystemObject") ' For VBA
Set oFi = Fso.OpenTextFile(File2, ForReading, TristateTrue)
if Not oFi.AtEndOfStream Then Rett = oFi.ReadAll
Set oFi = Nothing
Set Fso = Nothing
ElseIf ReadMethod = 3 Then ' Input all once
iFile = FreeFile()
Open File2 For Input As #iFile
Rett = Input(LOF(iFile), #iFile)
Close #iFile
ElseIf ReadMethod = 4 Then ' Input line-by-line
iFile = FreeFile()
Open File2 For Input As #iFile
Do Until EOF(1)
Line Input #iFile, F001
If Rett > "" Then Rett = Rett & vbCrLf
Rett = Rett & F001
Loop
Close #iFile
End If
ASCII_Read = Rett
End Function
Function ASCII_Save(File2, FileContent, Optional SaveMethod = 1)
' FileContent having the content of the file
' SaveMethod
' =1, save using ADODB stream, does not need Dir(), for UTF-8
' =2, save using Filesystemobject, does not need Dir()
' =3, save using Open+OutPut, replace file if found
' =4, save using Open+Append, appends file if found
If SaveMethod = 1 Then ' ADODB
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 ' Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" ' Specify charset For the source text data.
fsT.Open ' Open the stream And write binary data To the object
fsT.WriteText FileContent
fsT.SaveToFile File2, 2 'Save binary data To disk
Set fsT = Nothing
ElseIf SaveMethod = 2 Then ' FSO
Set FSO = CreateObject("scripting.FileSystemObject") ' for VBA
Set myFile = Fso.CreateTextFile(File2, true)
myFile.WriteLine(FileContent)
myFile.Close
ElseIf SaveMethod = 3 Then ' Save over
Close
Open File2 For Output As #1
Print #1, FileContent
Close
ElseIf SaveMethod = 4 Then ' Append
Close
Open File2 For Append As #1
Print #1, FileContent
Close
End If
End Function
' ReadMethod
' =1, read using ADODB stream, used for UTF-8 Unicode files.
' =2, reads using FileSystemObject, does not work with UTF-8
' =3, reads using 'Open+Input all bulk'
' =4, reads using 'Open+Input line by line'
'
Rett = ""
If ReadMethod = 1 Then ' ADODB
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile (File2)
Rett = objStream.ReadText()
objStream.Close
Set objStream = Nothing
ElseIf ReadMethod = 2 Then ' FSO
Dim Fso As Object, oFi As Object
Const ForReading = 1 ' 1 for reading, 8 for Appending
Const TristateTrue= 1 ' 0 for ASCII, 1 for Unicode, 2 for System default
Set Fso = CreateObject("Scripting.FileSystemObject") ' For VBA
Set oFi = Fso.OpenTextFile(File2, ForReading, TristateTrue)
if Not oFi.AtEndOfStream Then Rett = oFi.ReadAll
Set oFi = Nothing
Set Fso = Nothing
ElseIf ReadMethod = 3 Then ' Input all once
iFile = FreeFile()
Open File2 For Input As #iFile
Rett = Input(LOF(iFile), #iFile)
Close #iFile
ElseIf ReadMethod = 4 Then ' Input line-by-line
iFile = FreeFile()
Open File2 For Input As #iFile
Do Until EOF(1)
Line Input #iFile, F001
If Rett > "" Then Rett = Rett & vbCrLf
Rett = Rett & F001
Loop
Close #iFile
End If
ASCII_Read = Rett
End Function
Function ASCII_Save(File2, FileContent, Optional SaveMethod = 1)
' FileContent having the content of the file
' SaveMethod
' =1, save using ADODB stream, does not need Dir(), for UTF-8
' =2, save using Filesystemobject, does not need Dir()
' =3, save using Open+OutPut, replace file if found
' =4, save using Open+Append, appends file if found
If SaveMethod = 1 Then ' ADODB
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 ' Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" ' Specify charset For the source text data.
fsT.Open ' Open the stream And write binary data To the object
fsT.WriteText FileContent
fsT.SaveToFile File2, 2 'Save binary data To disk
Set fsT = Nothing
ElseIf SaveMethod = 2 Then ' FSO
Set FSO = CreateObject("scripting.FileSystemObject") ' for VBA
Set myFile = Fso.CreateTextFile(File2, true)
myFile.WriteLine(FileContent)
myFile.Close
ElseIf SaveMethod = 3 Then ' Save over
Close
Open File2 For Output As #1
Print #1, FileContent
Close
ElseIf SaveMethod = 4 Then ' Append
Close
Open File2 For Append As #1
Print #1, FileContent
Close
End If
End Function
File2, Optional ReadMethod
OR
File2, FileContent, Optional SaveMethod
OR
File2, FileContent, Optional SaveMethod
Views 5,402
Downloads 1,524
CodeID
DB ID
ANmarAmdeen
610
Revisions
v3.0
Tuesday
October
13
2020