Ok guys so I need to obtain a value from a JSON file to be used inside a VBScript.
Here is the sample content:
{
"installedPacks": {
"vanilla": {
"name": "vanilla",
"build": "1.7.10",
"directory": "%MODPACKS%\\vanilla"
}
I would like to read the contents of the file and locate specifically the build value (which in this case is 1.7.10) and assign it to a variable for later use.
I have an existing AppData variable that translates to:
objShell.ExpandEnvironmentStrings("%APPDATA%") & "\"
The file I need to open is in location: AppData & ".technic\installedPacks"
Here is the code I used.
Function ForgeJSON(strTxt)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile( AppData & "ModPacker\ForgeVer.json", 1)
installedPacks = objFile.ReadAll
Dim oRE
Dim colMatches
Dim oMatch, I
Set oRE = New Regexp
oRE.Global = True
oRE.Pattern = """build"":\s""(.+?)"""
oRE.IgnoreCase = False
Set colMatches = oRE.Execute(strTxt)
For Each oMatch In colMatches
If oMatch.SubMatches(0) = "recommended" Then
Else
strNextmap = oMatch.SubMatches(0)
End If
Next
If strNextmap = "" Or IsNull (strNextmap) Then
ParseJSON = "No Match Found"
Else
ParseJSON = strNextmap
End If
End Function
Related
I have written a VB script to count the number of rows from several CSV files and save in a File in FileRecordCount.csv file with the filename and number of rows. The code does not show any errors at all.
But the script is not working at all. I don't know what is the problem. Any help Any help would be greatly appreciated!????
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
vbsFile = Wscript.ScriptName
vbsFilePath = Wscript.ScriptFullName
sFolder = left(vbsFilePath,len(vbsFilePath)-(len(vbsFile)+1))
ResultsFile = sFolder & "\FileRecordCount.csv"
For Each objFile In objFSO.GetFolder(sFolder).Files
If UCase(objFSO.GetExtensionName(objFile.Name)) = "CSV" Then
oFile = objFile.path
Set objFile = objFSO.OpenTextFile(oFile, ForReading)
RowCount = 0
Do Until objFile.AtEndOfStream
WScript.Echo objFile.ReadLine
RowCount = RowCount + 1
Loop
'need to make a new file to write the results to
FileName = objFSO.GetFileName(ResultsFile)
strText = FileName & "," & RowCount
Set objFile = objFSO.OpenTextFile(ResultsFile, ForWriting)
objFile.WriteLine strText
objFile.Close
End if
Next
MsgBox "FileRowCount Complete"
The script has multiple issues. First, as #Flakes stated, the same objFile variable is used for the files being processed and the results file. Second, the results filename is being written to the results file instead of each processed file name. Additionally, the variable "oFile" is a string, so would be better named "strFile" and the script path directory can be derived a bit more elegantly. Also, as per #Flakes, I moved the results file open before the loop and the results file close after the loop and I named the results file with a .txt extension so it doesn't get processed as one of the CSV files. Also added a Create = True flag to the results file open, so it doesn't have to pre-exist.
Here is the edited script:
Const ForReading = 1
Const ForWriting = 2
Const Create = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
sFolder = objFSO.GetParentFolderName(WScript.ScriptFullName)
ResultsFile = sFolder & "\FileRecordCount.txt"
Set objResultsFile = objFSO.OpenTextFile(ResultsFile, ForWriting, Create)
For Each objFile In objFSO.GetFolder(sFolder).Files
If UCase(objFSO.GetExtensionName(objFile.Name)) = "CSV" Then
strFile = objFile.path
Set objReadFile = objFSO.OpenTextFile(strFile, ForReading)
RowCount = 0
FirstLine = True
Do Until objReadFile.AtEndOfStream
Line = objReadFile.ReadLine
RowCount = RowCount + 1
If FirstLine Then ColumnCount = UBound(Split(Line,",")) + 1
FirstLine = False
Loop
objReadFile.Close
strText = strFile & "," & RowCount & "," & ColumnCount
objResultsFile.WriteLine strText
End if
Next
objResultsFile.Close
WScript.Echo "File row/column count complete"
I have JSON file and this is a preview of its structure
Is there a way to cut off the 'allTests' part and export it to new JSON file?
Try the following. Special characters are preserved. Hopefully the relevant JSON is cut out.
Option Explicit
Public Sub GetJSONExtract()
Dim fso As Object, jsonFile As Object, jsonText As String, arr() As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set jsonFile = fso.OpenTextFile("C:\Users\User\Desktop\Sample.json")
jsonText = jsonFile.ReadAll
arr = Split(jsonText, Chr$(34) & "allTests" & Chr$(34))
jsonText = Replace$(arr(2), ":", vbNullString, 1, 1)
jsonText = Split(jsonText, Chr$(34) & "time" & Chr$(34))(0)
jsonText = Left$(jsonText, InStrRev(jsonText, ",") - 1)
With fso.CreateTextFile("C:\Users\User\Desktop\Test.json")
.write jsonText
End With
End Sub
Using: https://github.com/VBA-tools/VBA-JSON
Sub ParseItOut()
Const f_PATH As String = "C:\Users\Tim\Desktop\"
Dim fso, j, obj, subObj
Set fso = CreateObject("scripting.filesystemobject")
j = fso.OpenTextFile(f_PATH & "sample.json").ReadAll()
Set obj = JsonConverter.ParseJson(j)
'get the required section
Set subObj = obj("results")(1)("allTests")
'write to file as JSON
fso.CreateTextFile(f_PATH & "sample_mod.json").Write JsonConverter.ConvertToJson(subObj)
End Sub
EDIT: this seems to be a problem -
Under allTests each item is an object with a single property/key (which is very large and contains embedded quotes escaped by \) and a value of true
The library I used seems to have an issue with that (or I don't know how to use it correctly...)
This is the VBScript code answered here to get the JSON file from computer with proper values.
Set fso = CreateObject("Scripting.FileSystemObject")
json = fso.OpenTextFile("C:\path\to\combined.json").ReadAll
Set re = New RegExp
re.Pattern = """passed"":(true|false),"
re.IgnoreCase = True
For Each m In re.Execute(json)
passed = CBool(m.SubMatches(0))
Next
But I have a JSON file that looks like this which is online,
["AA-BB-CC-MAKE-SAME.json","SS-ED-SIXSIX-TENSE.json","FF-EE-EE-EE-WW.json","ZS-WE-AS-FOUR-MINE.json","DD-RF-LATERS-LATER.json","FG-ER-DC-ED-FG.json"]
How to download this JSON file and get the values to five variables using either VBScript or batch file?
Here is an example for downloading a json from internet and parse it :
Dim http,URL
URL = "http://ip-api.com/json/"
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET",URL,False
http.send
strJson = http.responseText
Set j = ParseJson(strJson)
Result = "IP =" & j.query & vbCrlf &_
"ISP = "& j.isp & vbCrlf &_
"Country = "& j.country & vbCrlf &_
"TimeZone = "& j.timezone
Wscript.echo Result
'--------------------------------------------------------
Function ParseJson(strJson)
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set ParseJson = window.json
End Function
'--------------------------------------------------------
You can give a try for this code :
Dim http,URL
URL = "https://privateURL/jsonfile/"
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET",URL,False
http.send
strJson = http.responseText
Result = Extract(strJson,"(\x22(.*)\x22)")
Arr = Split(Result,",")
For each Item in Arr
wscript.echo Item
Next
'******************************************
Function Extract(Data,Pattern)
Dim oRE,oMatches,Match,Line
set oRE = New RegExp
oRE.IgnoreCase = True
oRE.Global = True
oRE.Pattern = Pattern
set oMatches = oRE.Execute(Data)
If not isEmpty(oMatches) then
For Each Match in oMatches
Line = Line & Trim(Match.Value) & vbCrlf
Next
Extract = Line
End if
End Function
'******************************************
I have 6 text files in one folder.
I want combine selected files in to one text using access.
I have tried this code without success, because the one text file is created but is empty
Can any one help me on this?
Thanks in advance, my code below.
Lines in the text file:
xN;xDate;xNode;xCO;
100;2017-09-26 00:00:00;Valley;D6;
101;2017-09-25 00:00:00;Valley;D3;
...
...
Code:
Dim xPath
Function xExtract()
Dim xArray() As Variant
Dim I As Integer
Dim StrFileName As String
xPath = CurrentProject.Path
PDS:
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")
new_file = "" & xPath & "\PDS.txt"
fn = FreeFile
Open new_file For Output As fn
Close
For I = 0 To UBound(xArray)
StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(I) & ".txt"
fn = FreeFile
Open StrFileName For Input As fn
Open new_file For Append As fn + 1
Line Input #fn, dato
Do While Not EOF(fn)
Line Input #fn, dato
dati = Split(dato, Chr(9))
For d = 0 To UBound(dati)
If d = 0 Then
dato = Trim(dati(d))
Else
dato = dato & ";" & Trim(dati(d))
End If
Next
Print #fn + 1, dato
Loop
Close
Next I
Application.Quit
End Function
Here's code that works for concatenating comma delimited text files (probably would work for any text files). Pretty crude. Needs error handler and would benefit from common dialog to select output folder and file name. Also I don't like using non-typed variables, but I don't know what type of object some of them are and can't figure it out from Microsoft help. Warning, don't put output in same folder - might result in endless loop - trust me I tried it
Public Function CFiles(Filepath As String) As String
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Folder
Dim Filein As Object
Dim fileout As Object
Dim strText As String
Dim TheInputfile As Object
Dim filename As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(Filepath)
Set fileout = FSO.CreateTextFile("c:\InvestmentsPersonal\files\backup\output.txt", ForAppending, False)
For Each Filein In SourceFolder.Files
filename = Filein.Name
Set TheInputfile = FSO.OpenTextFile(Filepath & filename, ForReading)
strText = TheInputfile.ReadAll
TheInputfile.Close
fileout.WriteLine strText
Next
fileout.Close
Set fileout = Nothing
Set Filein = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
CFiles = "c:\InvestmentsPersonal\files\backup\output.txt"
End Function
As your code works for files with windows EOL format (CR (Carriage Return) + LF (Line Feed)), I guess your files are UNIX EOL format (just LF, no CR), check this with a texteditor like e.g. Notepad++ (View->Show Symbol->Show End of Line). This causesLine Inputto read the whole file in one line as it breaks on CR. Then you skip the first line and nothing is inserted, because all text is in this line.
You can useFileSystemObjectto avoid this as it breaks on LF.
Function xExtract()
Const ForReading = 1, ForWriting = 2, ForAppending = 8 'iomode constants
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'format constants
Dim xArray As Variant, dati As Variant
Dim i As Long, d As Long
Dim xPath As String, new_file As String, dato As String, StrFileName As String
Dim FSO As Object, TextStreamIn As Object, TextStreamOut As Object
xPath = CurrentProject.Path
new_file = xPath & "\PDS.txt"
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextStreamOut = FSO.OpenTextFile(new_file, ForWriting, True, TristateUseDefault) 'open textstream to write
For i = 0 To UBound(xArray) 'loop through files
StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(i) & ".txt"
Set TextStreamIn = FSO.OpenTextFile(StrFileName, ForReading) ' open textstream to read
TextStreamIn.SkipLine 'skip first line with headers
Do Until TextStreamIn.AtEndOfStream 'loop through lines
dati = Split(TextStreamIn.Readline, Chr(9))
For d = 0 To UBound(dati)
If d = 0 Then
dato = Trim(dati(d))
Else
dato = dato & ";" & Trim(dati(d))
End If
Next
TextStreamOut.WriteLine dato 'write line to file
Loop
TextStreamIn.Close 'close textstream
Next i 'next file
TextStreamOut.Close
Set TextStreamOut = Nothing
Set TextStreamIn = Nothing
Set FSO = Nothing
Application.Quit
End Function
If you want to stay withOpen fileyou can split the first (and only) line on LF (Split(dato,vbLf) and ignore the first element, but you have to check the file is UNIX EOL format, FSO covers both.
I have an attachment field in my accdb database file,
i'm trying to read it to extract the attachments but it keep return empty values
recording to this post Using Attachment field with Classic ASP
there is no way to do it with adodb, is true? and if yes, what other ways i have to do that ?
this is the code that i'm running:
qid = request.querystring("qid")
wikiDbAddress="database/my.accdb"
set cnWiki=server.CreateObject("adodb.connection")
cnWiki.open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Server.MapPath(root&wikiDbAddress)
SQL = "select * from [Knowledge Base] where id="&qid
RS.Open SQL, cnWiki
do while not RS.eof
response.write RS("attachments")
RS.movenext
loop
For now, i did some workaround that helped me, it's not efficient but does the work.
qid = request.querystring("qid")
name = request.querystring("name")
SQL = "select Attachments.FileName as fname, Attachments.FileData as data, Attachments.FileType as FileType from [Knowledge Base] where Attachments.FileName='"&name&"' and id="&qid
RS.Open SQL, cnWiki
do while not RS.eof
if rs("fname")= name then
filename = Server.MapPath("/KB_"&qid&"_"&rs("fname"))
set fs=Server.CreateObject("Scripting.FileSystemObject")
if not fs.FileExists(filename) then
SaveBinaryData filename, rs("data")
data = readBinary(filename)
' CHR(255) = FF, CHR(170) = AA
data = Mid(data, 21, Len(data) - 20)
writeBinary data,filename
end if
set fs=nothing
downloadFromFile(filename )
exit do
else
RS.movenext
end if
loop
rs.close
cnWiki.close
function downloadFromFile(strFile )
Dim objConn
Dim intCampaignRecipientID
If strFile <> "" Then
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.LoadFromFile(strFile)
Response.Clear
'Response.ContentType = "image/jpeg"
Response.Addheader "Content-Disposition", "attachment; filename=" & strFile
Response.BinaryWrite objStream.Read
objStream.Close
Set objStream = Nothing
End If
End Function
Function SaveBinaryData(FileName, ByteArray)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
'Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save binary data.
BinaryStream.Type = adTypeBinary
'Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.Write ByteArray
'Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
End Function
Function readBinary(path)
Dim a, fso, file, i, ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.getFile(path)
If isNull(file) Then
wscript.echo "File not found: " & path
Exit Function
End If
Set ts = file.OpenAsTextStream()
a = makeArray(file.size)
i = 0
While Not ts.atEndOfStream
a(i) = ts.read(1)
i = i + 1
Wend
ts.close
readBinary = Join(a,"")
End Function
Sub writeBinary(bstr, path)
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set ts = fso.createTextFile(path)
If Err.number <> 0 Then
wscript.echo Err.message
Exit Sub
End If
On Error GoTo 0
ts.Write(bstr)
ts.Close
End Sub
Function makeArray(n)
Dim s
s = Space(n)
makeArray = Split(s," ")
End Function