I have a bunch of text files in a folder that I need to change the encoding on to Unicode and instead of manually opening the files and saving them as Unicode I would like to have a script to do this.
The files are currently in UTF-8 encoding and my extremely limited scripting abilities can't figure this one out. I found the code below to convert to Unicode from ANSI and when I use this code it does convert it to Unicode but it messes up the characters so the conversion doesn't actually work. Any thoughts? Thanks in advance.
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder("C:\test")
Set oFiles = oFolder.files
For each file in oFiles
If Right(file.Name, 3) = "txt" Then
Set ANSIFile = fso.OpenTextFile(file.path, 1, False, False)
ANSIContent = ANSIFile.ReadAll
Set UNICODEFile = fso.OpenTextFile(file.path, 2, False, True)
UNICODEFile.Write ANSIContent
End If
Next
Unfortunately VBScript doesn't support this kind of conversion by itself. You can use an ADODB.Stream object, though:
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.LoadFromFile "C:\input.txt"
text = stream.ReadText
stream.Close
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\output.txt", 2, True, True)
f.Write text
f.Close
Or a little more streamlined:
Set fso = CreateObject("Scripting.FileSystemObject")
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.LoadFromFile "C:\input.txt"
fso.OpenTextFile("C:\output.txt", 2, True, True).Write stream.ReadText
stream.Close
If you want to replace the existing file you'll have to use the first version and use the same file for input and output. Use a loop like this to iterate over all files in a folder:
Set fso = CreateObject("Scripting.FileSystemObject")
Set stream = CreateObject("ADODB.Stream")
For Each f In fso.GetFolder("C:\source\folder").Files
stream.Open
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.LoadFromFile f.Path
text = stream.ReadText
stream.Close
fso.OpenTextFile(f.Path, 2, True, True).Write text
Next
Related
I am trying to run one script which parse url and projectname from file and try to download files from url into the zip format. I am seeing error this while writing file to the folder. I am using windows sserver 2012 R2
ADODB.Stream : Write to the file failed
I've verified IUSER and other users have full access to the target and source folder.
Here is the script. May I know if something I am missing here?
Dim URLFile
Dim URLLine, URL, ProjectName
Dim xHttp, bStrm
Set objShell = CreateObject("WScript.Shell")
Set WshShell = WScript.CreateObject("WScript.Shell")
set fso = createobject("scripting.filesystemobject")
Set URLFile = fso.OpenTextFile("C:\Temp\Scripts\VBScripts\URLList.txt")
do while not URLFile.AtEndOfStream
URLLine = URLFile.ReadLine()
'Wscript.Echo URLLine
if len(URLLine)>10 then
URL = Left(URLLine,inStr(URLLine,";")-1)
ProjectName = Right(URLLine,Len(URLLine)-inStr(URLLine,";"))
Set xHttp = createobject("Microsoft.XMLHTTP")
Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", URL, False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Backups\"&"Backup Zip All Files for "&ProjectName&"-"&cStr(Date)&".zip", 2 '//overwrite
end with
Set xHttp = Nothing
Set bStrm = Nothing
end if
loop
If you get past the permissions thing by making read/write for Everyone, all you need then is a module to perform the ZIP function.
I usually use a commercial DLL and there are many to choose from.
I have a PDF file that I have created in Bluebeam. It has shapes, images and text boxes throughout it.
Using VBA in Excel, I want to replace all occurrences of a string. I've tried many different peoples suggestions from other pages which successfully replace the string however, when i open the file in bluebeam, many of the shapes will have shifted or disappeared. The files encoding is ANSI.
Any wisdom to replace occurrences without messing up the other contents of the file?
Here is the code ive been playing with (from here):
Sub Test()
Dim objFSO
Const ForReading = 1
Const ForWriting = 2
Dim objTS 'define a TextStream object
Dim strContents As String
Dim fileSpec As String
fileSpec = ThisWorkbook.path & "\Template.pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(fileSpec, ForReading, False)
strContents = objTS.ReadAll
strContents = replace(strContents, "PLACEHOLDER", "TOPDOG")
objTS.Close
Set objTS = objFSO.OpenTextFile(fileSpec, ForWriting)
objTS.Write strContents
objTS.Close
End Sub
I made a macro that generate a .csv file with datas from an excel sheet.
When I click on a button, this csv file is send to a server and is consummed after minutes.
It works perfectly.
The only problem is that this csv file is generated in UTF-8 with BOM and I don't want that, I need UTF-8 without BOM
I got inspired from this function that I found simply and easy to read :
Use "ADODB.Stream" to convert ANSI to UTF-8, miss 1-2 character in the first row
I tried to adapt it into this :
Function ConvertToUtf8(myFileIn, myFileOut)
Dim stream, strText
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2 'text
stream.Charset = "_autodetect_all"
stream.Open
stream.LoadFromFile myFileIn
strText = stream.ReadText
stream.Close
stream.Type = 2
stream.Charset = "utf-8"
stream.Open
stream.Position = 3 'without BOM (doesn't work)
stream.WriteText strText
stream.SaveToFile myFileOut, 2
stream.Close
Set stream = Nothing
End Function
I don't know why but it creates the file into UTF-8 without BOM but this error pop-up :
(https://imgur.com/a/FhJDAzh)
I'm pretty sure I'm not far from the solution but I don't find it
When I click on "debug", this line is in cause :
stream.Position = 3 'without BOM (doesn't work)
EDIT
Finally I found exactly what I was looking for, instead of a function which convert the file, a more efficient function to write directly in UTF-8 without BOM in the file :
Function WriteUTF8WithoutBOM(chaine As String, nomfichier As String)
Dim UTFStream As Object, BinaryStream As Object
With CreateObject("adodb.stream")
.Type = 2
.Mode = 3
.Charset = "UTF-8"
.LineSeparator = -1
.Open
.WriteText chaine, 1
.Position = 3 'skip BOM
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = 1
BinaryStream.Mode = 3
BinaryStream.Open
'Strips BOM (first 3 bytes)
.CopyTo BinaryStream
.Flush
.Close
End With
BinaryStream.SaveToFile nomfichier, 2
BinaryStream.Flush
BinaryStream.Close
End Function
For the credit, I found it here https://www.excel-downloads.com/threads/question-de-conversion-en-utf-8-pour-une-vba-qui-enregistre-un-txt.20011510/ (Staple1600 answer)
Const ForReading = 1
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
strSource = "C:\Users\Desktop\test.csv"
Set File = fso.OpenTextFile(strSource, ForReading)
strText = File.ReadAll
File.Close
strNewText = Replace(strText,",","|")
Set File = fso.OpenTextFile(strSource, ForWriting, True)
File.WriteLine strNewText
File.Close
This is the code Im using and the result I get is:
xxxx|yyyy|zzzzz|||||||||||||||||||||
The pipe character '|' must be replaced with 'null' or '' if its repeated more than five times and I have tried using trim, replace and mid functions but couldn't get the solution. Thanks
You're trying to limit the "|" to 5 consecutive entries?
There may be a prettier way, but this would work
Do While InStr(1, strNewText, "||||||") > 0
strNewText = Replace(strNewText, "||||||", "|||||")
Loop
You could use the following regular expression:
\|{5,}
as follows:
Const ForReading = 1
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
path = "C:\Users\Desktop\test.csv"
Set file = fso.OpenTextFile(path, ForReading)
strText = file.ReadAll
file.Close
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.Pattern = "\|{5,}"
strNewText = re.Replace(strText, "")
Set file = fso.OpenTextFile(strSource, ForWriting, True)
file.WriteLine strNewText
file.Close
NB. Consider using Option Explicit at the beginning of your script; it will save you from misspelled and confused variables.
I am using Excel 2003 & I have following code in my macro.
Dim fs, a, retstring
Set fs = CreateObject("scripting.filesystemobject")
Set a = fs.OpenTextFile("C:\file.txt", ForReading, False)
Do While a.AtEndofStream <> True
retstring = a.ReadLine
Loop
a.Close
When I execute this, it shows
"Runtime Error:5"
Invalid Procedure Call or argument at OpenTextFile
You must define the constant ForReading first. And you may as well define the constants ForWriting and ForAppending while you're at it.
Dim fs, a, retstring
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile("C:\file.txt", ForReading, False)
Do While a.AtEndofStream <> True
retstring = a.readline
Loop
a.close
fso is considered slow. Here is a faster method to read a text file.
Sub Sample()
Dim MyData As String, strData() As String
Dim i as Long
'~~> Read the entire file in 1 go
Open "C:\MyFile.Txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
For i = LBound(strData) To UBound(strData)
Debug.Print strData(i)
Next
End Sub
It worked when i did like this.
Dim fs, a, retstring
Set fs = CreateObject("scripting.filesystemobject")
Set a = fs.OpenTextFile("C:\Users\228319\Desktop\file.txt", 1, False)
Do While a.AtEndofStream <> True
retstring = a.readline
Loop
a.Close
I am using Excel 2007 and got the same problem with near the same code snippet. Enabling 'Microsoft Scripting Runtime' should solve it (Main menu >Tools > References), it worked for me.