Hi I am sorry I cannot figure it out. I tried opening a txt changing its charset to UTF8 and save it under the same filename but that does not work.
Dim Dateisystem, Textdatei, text
Set Dateisystem = CreateObject("Scripting.FileSystemObject")
Set Textdatei = Dateisystem.OpenTextFile("titel.txt")
text = Textdatei.ReadAll
Const adModeReadWrite = 3
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Sub SaveToFile(text, filename)
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = "UTF-8"
.Open
.SaveToFile filename, adSaveCreateOverWrite
.Close
End With
End Sub
SaveToFile text, "titel.txt"
Try This :
Set stream = CreateObject("ADODB.Stream")
Set fso = CreateObject("Scripting.FileSystemObject")
stream.Open
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.LoadFromFile "C:\Your-File-Here(Input).txt"
text = stream.ReadText
stream.Close
Set f = fso.OpenTextFile("C:\Your-File-Here(Output).txt", 2, True, True)
f.Write text
f.Close
Related
The following code i used for Uploading code without loop and code works fine while i use no loop function.
dim strURL
Dim password
Dim username
Set wshShell = CreateObject("WScript.Shell")
UploadDest= wshShell.ExpandEnvironmentStrings("https://webdav.pcloud.com/Public%20Folder/")
UploadFile = wshShell.ExpandEnvironmentStrings("%username%.txt")
username = "abc#gmail.com"
password = "abc"
sData = getFileBytes(UploadFile, UploadType)
Set HttpReq =createobject("Microsoft.XMLHTTP")
strURL = UploadDest & "/" & UploadFile
HttpReq.Open "PUT",strURL,False,username,password
HttpReq.send sData
function getFileBytes(flnm,sType)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
if sType="binary" then
objStream.Type = 1 ' adTypeBinary
else
objStream.Type = 2 ' adTypeText
objStream.Charset ="ascii"
end if
objStream.Open
objStream.LoadFromFile flnm
if sType="binary" then
getFileBytes=objStream.Read 'read binary'
else
getFileBytes= objStream.ReadText 'read ascii'
end if
objStream.Close
Set objStream = Nothing
end function
But when I use above code in loop i got syntax error in line no:12
function getFileBytes(flnm,sType)
I used following code to upload file in loop in every 10 sec .
set i = 0
Do While i = 0
dim strURL
Dim password
Dim username
Set wshShell = CreateObject("WScript.Shell")
UploadDest= wshShell.ExpandEnvironmentStrings("https://webdav.pcloud.com/Public%20Folder/")
UploadFile = wshShell.ExpandEnvironmentStrings("%username%.txt")
username = "abc#gmail.com"
password = "abc"
sData = getFileBytes(UploadFile, UploadType)
Set HttpReq =createobject("Microsoft.XMLHTTP")
strURL = UploadDest & "/" & UploadFile
HttpReq.Open "PUT",strURL,False,username,password
HttpReq.send sData
function getFileBytes(flnm,sType)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
if sType="binary" then
objStream.Type = 1 ' adTypeBinary
else
objStream.Type = 2 ' adTypeText
objStream.Charset ="ascii"
end if
objStream.Open
objStream.LoadFromFile flnm
if sType="binary" then
getFileBytes=objStream.Read 'read binary'
else
getFileBytes= objStream.ReadText 'read ascii'
end if
objStream.Close
Set objStream = Nothing
end function
WScript.Sleep(10000)
loop
You can't define a Function inside a Loop
Rewrite like this to define the function outside of the loop:
Dim i
Do While i = 0
dim strURL
Dim password
Dim username
Set wshShell = CreateObject("WScript.Shell")
UploadDest= wshShell.ExpandEnvironmentStrings("https://webdav.pcloud.com/Public%20Folder/")
UploadFile = wshShell.ExpandEnvironmentStrings("%username%.txt")
username = "abc#gmail.com"
password = "abc"
sData = getFileBytes(UploadFile, UploadType)
Set HttpReq =createobject("Microsoft.XMLHTTP")
strURL = UploadDest & "/" & UploadFile
HttpReq.Open "PUT",strURL,False,username,password
HttpReq.send sData
WScript.Sleep(10000)
loop
function getFileBytes(flnm,sType)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
if sType="binary" then
objStream.Type = 1 ' adTypeBinary
else
objStream.Type = 2 ' adTypeText
objStream.Charset ="ascii"
end if
objStream.Open
objStream.LoadFromFile flnm
if sType="binary" then
getFileBytes=objStream.Read 'read binary'
else
getFileBytes= objStream.ReadText 'read ascii'
end if
objStream.Close
Set objStream = Nothing
end function
My IBM MQ is not accepting XML file saved in UTF-8 format. I want to try if it accepts UTF-8 without BOM format. I have tried multiple things, but was unable to save the file in non-BOM format. My code is below.
Dim objStreamUTF8 : Set objStreamUTF8 = CreateObject("ADODB.Stream")
Dim objStreamUTF8NoBOM : Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")
With objStreamUTF8
.Charset = "UTF-8"
.Mode = 3
.Type = 2
.Open
objStreamUTF8.LoadFromFile uxtNewRenamePath'"C:\WINDOWS\Temp\DataFiles\TC10_ Apostrophe symbol in tag Cdtr_Adrline2_Pacs8_TxID201765133641.xml"
objStreamUTF8.Flush
strFileText = objStreamUTF8.ReadText()
strFileText = Replace(strFileText,"&#", "&#")
strFileText = Replace(Replace(Replace(Replace(Replace(strFileText, "GreaterThanSymbol", ">"), "LessThanSymbol", "<"), "ApostropheSymbol", "'"), "AmpersandSymbol", "&"), "DoubleQuotesSymbol", chr(34))
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile uxtNewRenamePath, True
Set objFSO = Nothing
.Position = 0
.Flush
.WriteText strFileText
.SaveToFile uxtNewRenamePath, 2
.Close
.Type = 1
.Open
.Position = objStreamUTF8.Size
End With
With objStreamUTF8NoBOM
.Mode = 3
.Type = 1
.Open
objStreamUTF8.CopyTo objStreamUTF8NoBOM
.SaveToFile uxtNewRenamePath, 2
End With
objStreamUTF8.Close
objStreamUTF8NoBOM.Close
When objStreamUTF8NoBOM is saved to file, the file is completely blank. Can you please tell me what I am doing wrong or how I can save the file in the desired format?
Got it. The position of the first stream has to be set to 3rd postion to skip BOM characters
i.e. objStreamUTF8.Position = 3
I got some script to convert string to base64 and write encoded data to text file that's all goes fine and result stored in encoded.txt but I need each line to be double quoted at the start and '& _' with double quotes at the end so how to make this script do that automatically for each line? here is my script
Option Explicit
Const fsDoOverwrite = true
Const fsAsASCII = false
Const adTypeBinary = 1
Dim objFSO
Dim objFileOut
Dim objXML
Dim objDocElem
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile(Wscript.scriptfullname)
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.dataType = "bin.base64"
objDocElem.nodeTypedValue = objStream.Read()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileOut = objFSO.CreateTextFile("encoded.txt", fsDoOverwrite, fsAsASCII)
objFileOut.Write objDocElem.text
objFileOut.Close()
Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing
Sub encodeFileBase64( inputFile, outputFile )
Const fsDoOverwrite = True
Const fsAsASCII = False
Const adTypeBinary = 1
Dim stream, strBuffer
Set stream = WScript.CreateObject("ADODB.Stream")
With stream
.Type = adTypeBinary
.Open
.LoadFromFile inputFile
End With
With WScript.CreateObject("MSXML2.DOMDocument").CreateElement("Base64Data")
.dataType = "bin.base64"
.nodeTypedValue = stream.Read()
strBuffer = .Text
End With
stream.Close
With New RegExp
.Multiline = True
.Global = True
.IgnoreCase = False
.Pattern = "[\r\n]+(?=[0-9A-Za-z])"
strBuffer = Chr(34) & .Replace(strBuffer, Chr(34) & " & _" & vbCrLf & Chr(34) ) & Chr(34)
End With
WScript.CreateObject("Scripting.FileSystemObject").CreateTextFile( outputFile, fsDoOverwrite, fsAsASCII ).Write strBuffer
End Sub
encodeFileBase64 WScript.ScriptFullName, WScript.ScriptFullName & ".b64"
This will use a regular expression object to replace all intermediate line endings with the adecuated line termination/start and two aditional quotes, one at the start and one at the end.
Split the text by a line break, then loop through and put it all back together while you add the quotes. (not tested, but probably close, code follows; there is a strong chance you'll need to find the right type of line feed for your situation - I picked vbCr as an example):
allTextArray = SPLIT(originalText, vbCr)
For i=0 to UBound(allTextArray)
allTextWithQuotes = allTextWithQuotes & """" & allTextArray(i) & """"
Next
Im trying to make a batch file or vbs file to download a .csv file but when i get to the website it has a popup!!(different window) that is asking to log in with user and password then i must hit the "OK" button. how do i tell the batch file to jump to the pop up and log in with the user name and password?
i found this code vbs code. but it get stuck on the pop up. and i must do it manually.
VBS CODE:
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "https://api.twilio.com/2010-04-01/Accounts/ACxxxxxx9/Calls.csv?PageSize=1000"
IE.Visible = True
While IE.Busy
WScript.Sleep 50
Wend
Set ipf = IE.document.all.UserNamer
ipf.Value ="MYUSERNAME"
Set ipf = IE.document.all.Password
ipf.Value ="MYpassword"
Set ipf = IE.document.all.submit
ipf.Click
IE.Quit
`
And tried
Set args = WScript.Arguments
'// you can get url via parameter like line below
'//Url = args.Item(0)
Url = "https://USERNAME:PASSWORD#api.twilio.com/2010-04-01/Accounts/ACfcxxxxxxxxx059/Calls.csv? PageSize=1000"
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", Url, False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Users\jeff\Downloads"
end with
Whats the best why i can automatically download this file?
THIS IS THE WORKING FILE.
'GetRemoteBinaryFile.vbs
CSVFile = "Calls.csv"
DestFolder = "C:\Downloads"
URL = "www.itworks.com"
bstrUser= username
bstrPassword=password
Set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", URL, False,bstrUser,bstrPassword
xml.Send
set oStream = createobject("Adodb.Stream")
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
oStream.type = adTypeBinary
oStream.open
oStream.write xml.responseBody
' Do not overwrite an existing file
oStream.savetofile "Calls.csv", adSaveCreateNotExist
' Use this form to overwrite a file if it already exists
' oStream.savetofile DestFolder & ImageFile, adSaveCreateOverWrite
oStream.close
set oStream = nothing
Set xml = Nothing
How to save all text with replaced text.
At now save only replaced text
I want to change only 9752951c-0392-71e1-01a3- ac10016b0000 in txt
1.txt
text ...
<URL>http://bs.com/opr-console/rest/9.10/event_list/9752951c-0392-71e1-01a3- ac10016b0000</URL>
<method>PUT</method>
<auth-methods>DIGEST</auth-methods>
<auth-preemptive>true</auth-preemptive>
<auth-username>admin</auth-username>
<auth-password>rO0ABXQABWFkbWlu</auth-
.....bla-bla-la..
vbs script:
Dim objExec, objShell, objWshScriptExec, objStdOut, objArgs, ReplaceWith
Const ForReading = 1
Const ForWriting = 2
Set objArgs = WScript.Arguments
strID = Trim(objArgs(0))
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "^<URL>http://bsmgw.bms.consulting.com/opr-console/rest/9.10/event_list/"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\test\1\1.txt", ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch In colMatches
Wscript.Echo strSearchString
st = Mid(strSearchString, 71, 36)
WScript.Echo st
strNewFileName = Replace(strSearchString, st, strID)
Wscript.Echo strNewFileName
objFile.Write
Next
End If
Loop
objFile.Close
objFile.Close
objFile.Close
Personally, I would make changes to your file using an XML parser instead:
' load the document into an object
Dim xmldoc: set xmldoc = CreateObject("MSXML2.DomDocument")
xmldoc.async = false
xmldoc.setProperty "SelectionLanguage", "XPath"
xmldoc.load "C:\test\1\1.txt"
' get the URL node (look up XPath - i'm assuming that there is a single node called URL)
dim urlnode: set urlnode = xmldoc.selectSingleNode("//URL")
' replace the innerText of the URL node with your replacement text
urlnode.text = strID
'save your document
xmldoc.Save "C:\test\1\2.txt"