I have a standalone VBScript which connects to server and gets the response text(as XML) in a WinHttpRequest object. Now, my question is how do I parse the XML content in it. When I post a request(strPostData) I need to parse the response XML. What I am using below is not working as I'm unable to print output on the console. I'm able to output the ResponseText though. But I'm unable to parse it.
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.Send(strPostData)
objWinHttp.WaitForResponse()
If objWinHttp.Status = "200" Then
GetDataFromURL = objWinHttp.ResponseText
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.loadXML(GetDataFromURL)
Set ops = xmlDoc.getElementsByTagName("Response\Status").item(0).text
WScript.Echo "Output is: " & ops
WScript.Echo "Message: " & GetDataFromURL
Msgbox GeteDataFromURL
WScript.Quit(0)
Here is the XML to be parsed:
<RCTRequest>
<Response>
<Name>aaa</Name>
<Status>44</Status>
</Response>
</RCTRequest>
You can use XPath
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = false
xmlDoc.SetProperty "SelectionLanguage", "XPath"
xmlDoc.loadXML(GetDataFromURL)
Set ops =xmlDoc.SelectSingleNode("/RCTRequest/Response/Status")
WScript.Echo "Output is: " & (ops.text)
WScript.Echo "Message: " & GetDataFromURL
Msgbox GeteDataFromURL
WScript.Quit(0)
I suppose you get "runtime error: Object required" error. It is caused by the line
Set ops = xmlDoc.getElementsByTagName("Response\Status").item(0).text
Just remove set from the beginning of that line.
You're on the right track using XMLDOM. Check out my article Reading XML Files in WSH for examples on how to parse specific data from an XML input.
strFile = "inp.xml"
Set objFS = CreateObject( "Scripting.FileSystemObject" )
set xmlDoc=CreateObject("Microsoft.XMLDOM")
xmlDoc.async="false"
xmlDoc.load(strFile)
For each x in xmlDoc.documentElement.attributes
WScript.Echo x.nodeName, x.text
Next
set xmlCol = xmlDoc.documentElement.childNodes
For Each Elem In xmlCol
If StrComp(Elem.nodeName, "p") = 0 Then
set nestedChild = Elem.childNodes
For Each node In nestedChild
If StrComp(node.nodeName, "XYZ") = 0 Then
WScript.Echo Elem.xml
set a = objFS.CreateTextFile("testfile.txt", true)
a.WriteLine(Elem.xml)
a.Close()
End If
Next
End If
Next
Related
Is there a way to perform an HTTP GET request within a Visual Basic script? I need to get the contents of the response from a particular URL for processing.
Dim o
Set o = CreateObject("MSXML2.XMLHTTP")
o.open "GET", "http://www.example.com", False
o.send
' o.responseText now holds the response as a string.
You haven't at time of writing described what you are going to do with the response or what its content type is. An answer already contains a very basic usage of MSXML2.XMLHTTP (I recommend the more explicit MSXML2.XMLHTTP.3.0 progID) however you may need to do different things with the response, it may not be text.
The XMLHTTP also has a responseBody property which is a byte array version of the reponse and there is a responseStream which is an IStream wrapper for the response.
Note that in a server-side requirement (e.g., VBScript hosted in ASP) you would use MSXML.ServerXMLHTTP.3.0 or WinHttp.WinHttpRequest.5.1 (which has a near identical interface).
Here is an example of using XmlHttp to fetch a PDF file and store it:-
Dim oXMLHTTP
Dim oStream
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
oXMLHTTP.Open "GET", "http://someserver/folder/file.pdf", False
oXMLHTTP.Send
If oXMLHTTP.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write oXMLHTTP.responseBody
oStream.SaveToFile "c:\somefolder\file.pdf"
oStream.Close
End If
If you are using the GET request to actually SEND data...
check:
http://techhelplist.com/index.php/tech-tutorials/37-windows-troubles/60-vbscript-sending-get-request
The problem with MSXML2.XMLHTTP is that there are several versions of it, with different names depending on the windows os version and patches.
this explains it:
http://support.microsoft.com/kb/269238
i have had more luck using vbscript to call
set ID = CreateObject("InternetExplorer.Application")
IE.visible = 0
IE.navigate "http://example.com/parser.php?key=" & value & "key2=" & value2
do while IE.Busy....
....and more stuff but just to let the request go thru.
strRequest = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" " &_
"xmlns:tem=""http://tempuri.org/"">" &_
"<soap:Header/>" &_
"<soap:Body>" &_
"<tem:Authorization>" &_
"<tem:strCC>"&1234123412341234&"</tem:strCC>" &_
"<tem:strEXPMNTH>"&11&"</tem:strEXPMNTH>" &_
"<tem:CVV2>"&123&"</tem:CVV2>" &_
"<tem:strYR>"&23&"</tem:strYR>" &_
"<tem:dblAmount>"&1235&"</tem:dblAmount>" &_
"</tem:Authorization>" &_
"</soap:Body>" &_
"</soap:Envelope>"
EndPointLink = "http://www.trainingrite.net/trainingrite_epaysystem" &_
"/trainingrite_epaysystem/tr_epaysys.asmx"
dim http
set http=createObject("Microsoft.XMLHTTP")
http.open "POST",EndPointLink,false
http.setRequestHeader "Content-Type","text/xml"
msgbox "REQUEST : " & strRequest
http.send strRequest
If http.Status = 200 Then
'msgbox "RESPONSE : " & http.responseXML.xml
msgbox "RESPONSE : " & http.responseText
responseText=http.responseText
else
msgbox "ERRCODE : " & http.status
End If
Call ParseTag(responseText,"AuthorizationResult")
Call CreateXMLEvidence(responseText,strRequest)
'Function to fetch the required message from a TAG
Function ParseTag(ResponseXML,SearchTag)
ResponseMessage=split(split(split(ResponseXML,SearchTag)(1),"</")(0),">")(1)
Msgbox ResponseMessage
End Function
'Function to create XML test evidence files
Function CreateXMLEvidence(ResponseXML,strRequest)
Set fso=createobject("Scripting.FileSystemObject")
Set qfile=fso.CreateTextFile("C:\Users\RajkumarJoshua\Desktop\DCIM\SampleResponse.xml",2)
Set qfile1=fso.CreateTextFile("C:\Users\RajkumarJoshua\Desktop\DCIM\SampleReuest.xml",2)
qfile.write ResponseXML
qfile.close
qfile1.write strRequest
qfile1.close
End Function
I need to download all the attachments from all the tests within the test plan. I have a function that should do that and I need some advice with it.
I have posted the function that I have used to get all the attachments. I have tried retrieving the attachments based on a path that is given.
I have tried changing the filter based on values I have found in the CROS_REF table, CR_REFERENCE field.
Public Function DownloadAttachments(TDFolderPath, sDownloadTo)
Dim otaAttachmentFactory 'As TDAPIOLELib.AttachmentFactory
Dim otaAttachment 'As TDAPIOLELib.Attachment
Dim otaAttachmentList 'As TDAPIOLELib.List
Dim otaAttachmentFilter 'As TDAPIOLELib.TDFilter
Dim otaTreeManager 'As TDAPIOLELib.TreeManager
Dim otaSysTreeNode 'As TDAPIOLELib.SysTreeNode
Dim otaExtendedStorage 'As TDAPIOLELib.TreeManager
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strPath 'As String
Set otaTreeManager = QCUtil.TDConnection.TreeManager
Set otaSysTreeNode = otaTreeManager.NodeByPath(TDFolderPath)
Set otaAttachmentFactory = otaSysTreeNode.Attachments
Set otaAttachmentFilter = otaAttachmentFactory.Filter
otaAttachmentFilter.Filter("CR_REFERENCE") = "'ALL_LISTS_" & otaSysTreeNode.NodeID & "_*'"
Set otaAttachmentList = otaAttachmentFilter.NewList
DowloadAttachments = ""
If otaAttachmentList.Count > 0 Then
For i = 1 to otaAttachmentList.Count
set otaAttachment = otaAttachmentList.Item(i)
otaAttachment.Load True, ""
If (fso.FileExists(otaAttachment.FileName)) Then
strFile = otaAttachmentList.Item(i).Name
myarray = split(strFile,"ALL_LISTS_"& otaSysTreeNode.NodeID & "_")
fso.CopyFile otaAttachment.FileName, sDownloadTo & "\" & myarray(1)
Reporter.ReportEvent micPass, "File Download:", myarray(1) & " downloaded to " & sDownloadTo
DownloadAttachments = sDownloadTo
end if
Next
Else
Reporter.ReportEvent micFail, "No attachments to download", _
"No attachments found in specified folder '" & TDFolderPath & "'."
DowloadAttachments = "Empty"
End If
Set otaAttachmentFactory = Nothing
Set otaAttachment = Nothing
Set otaAttachmentList = Nothing
Set otaAttachmentFilter = Nothing
Set otaTreeManager = Nothing
Set otaSysTreeNode = Nothing
Set fso = nothing
End Function
Regardless of what (valid) path I have tried, the result is the same. It says that there are no attachments to download.
I`m pretty sure the issue is in this piece of code:
Set otaAttachmentFilter = otaAttachmentFactory.Filter
otaAttachmentFilter.Filter("CR_REFERENCE") = "'ALL_LISTS_" & otaSysTreeNode.NodeID & "_*'"
Also, if anyone has any advice over other approaches, any help would be gladly appreciated! Thank you
otaAttachmentFilter.Filter("CR_Reference") = "'ALL_LISTS_" & otaSysTreeNode.NodeID & _"_" & sDownloadTo & "'"
Check this solution out. It might work.
I want to update the Unbound_DNS configuration file from a raw source but I can not get the desired result.
I would like to format each entry (each line):
address=/abc.com/0.0.0.0
To
local-zone: "abc.com" redirect
local-data: "abc.com 86400 IN A 0.0.0.0"
Here is what I did (thanks to hackoofr):
Option Explicit
Dim URL,Save2File,ws
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, """" & WScript.ScriptFullName & """ /elevate", "", "runas", 1
WScript.Quit
End If
URL = "https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt"
Set ws = CreateObject("wscript.Shell")
Save2File = ws.ExpandEnvironmentStrings("%Windir%\Temp\test")
Call Download(URL,Save2File)
'**********************************************************************************************
Sub Download(URL,Save2File)
Dim File,Line,BS,ws,RegExp
On Error Resume Next
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET",URL, False
File.Send
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 3600 IN A 0.0.0.0"
'**********************************************************************************************
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
'**********************************************************************************************
' Clean cache DNS
'**********************************************************************************************
wshShell.run("cmd /c psexec \\ -s ipconfig /flushdns >> & hostName,TRUE")
ElseIf File.Status = 404 Then
MsgBox "UpdateHostname.vbs : File Not Found : " & File.Status,vbCritical,"UpdateHostname.vbs : Error File Not Found"
Else
MsgBox "UpdateHostname.vbs : Unknown Error : " & File.Status,vbCritical,"UpdateHostname.vbs : Error getting file"
End If
End Sub
'**********************************************************************************************
Thank you in advance for your help.
Edit 1:
The content does not change. File.ResponseBody returns the content correctly, but no modification by the regexp!
Replace the following code:
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
with this:
Dim objReg, strTest, objMatches, objMatch
Set objReg = New RegExp
strTest = File.ResponseBody 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strTest = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&""""
Next
File.ResponseBody = strTest
set objReg = Nothing
Click for Regex Demo(in the demo, / is escaped by \)
Regex Explanation:
address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})
address=/ - matches address=/ literally
(.*?) - matches 0+ occurrences of any character(except a newline), as few as possible. The parenthesis are used to capture this match as group 1
/ - matches / literally
(\d{1,3}(?:\.\d{1,3}){3}) - matches a string of the pattern 12.222.212.33 and captures it in Group 2
Update:
Here is my final solution. From what I could understand from your code, you first get the response body from the server, modify and store the updated response in a file called test in the temp folder. Below is the code I have written to do the same thing. I have tested it on my system and the final output which gets stored in the C:\Windows\Temp\test.txt file looks correct as shown in the attached screenshot. Now, this may not be exactly what you want but you can get an idea from this. Store this code in a new vbs file and run it directly as it is.
Note: Since the response text from the server is very long, It takes a bit long to get executed. If you just want to see if it is working or not, uncomment the code inside the for loop. You will be able to see that you are getting the desired result for the first few URLs
Regex Demo
Option Explicit
Dim File, objReg, strTest, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
Set objReg = New RegExp
strTest = File.responseText 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strReplace = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&"""" & vbCrLf
strTest = Replace(strTest,objMatch.Value,strReplace)
'Uncomment the following code to see the result for the 1st 5 URLs, if the whole thing is taking too long to get executed
'i=i+1
'If(i>5) Then
' Exit for
'End If
Next
set objReg = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If
Output:
Here is the update of the code that works very well based on the response of #Gurman and the comment of #Ansgar Wiechers. Thank you for your help
Option Explicit
Dim File, objReg, strTest, RegExp, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 86400 IN A 0.0.0.0"
'**********************************************************************************************
strTest = File.responseText
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})"
strReplace = "local-zone: ""$1"" redirect" & vbCrLf & "local-data: ""$1 86400 IN A $2"""
strTest = RegExp.Replace(strTest, strReplace)
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If
The script I have here is attempting to do recurse through an XML file, storing each RegEx match (stored in a search array) into 2 result arrays; 1 for start date, 1 for end date.
Ubounds of both arrays are checked for equality then the text is passed to a function that uses XMLDOM to find the End_Date node in each parent node, then passes that text to another function, adding 30 days and then passing it back, replacing the previous value. Then it's supposed to write back the contents to the file and save it.
I've got a few problems here. 1. I can't get the +30 day value to be passed back to anything past the first parent node--memory space seems to retain the +30 day value from previous For-Each iteration. 2. I can't write anything back to the file.
I was initially writing for text files, but the format changed to XML as the requirements changed on our project.
I'd love to be able to do this all in XMLDOM in vbscript and just use functions to do specific data changes. But my main concern is my sloppy script not doing the basics.
Can anyone help me by pointing out the flaws in the loops I'm running? I've hit a wall and just can't seem to make any more progress!
Here's the XML file I'm reading(shortened to 2 Ad nodes w/ a ton of child nodes removed):
<?xml version="1.0" encoding="utf-8"?>
<XMLFeederRoot>
<ADS_CREATE_TIME>2016-06-07T01:35:39</ADS_CREATE_TIME>
<Ad>
<Ad_Number>d00524224</Ad_Number>
<Start_Date>2016-08-20T00:00:00</Start_Date>
<End_Date>2016-08-20T00:00:00</End_Date>
<Status>Run</Status>
</Ad><Ad>
<Ad_Number>d00524225</Ad_Number>
<Start_Date>2016-08-20T00:00:00</Start_Date>
<End_Date>2016-08-20T00:00:00</End_Date>
<Status>Run</Status>
</Ad>
</XMLFeederRoot>
Here's the script:
'Setting the Regular Expression object and setting occurrences to all in strings searched.
Set objRegEx= CreateObject("VBScript.RegExp")
objRegEx.Global= True
set Shell= createobject("wscript.shell")
Dim FSO, FLD, FIL, TS, strDate, strEDat, i, d, c
Dim strFolder, strContent, strPath
Const ForReading= 1, ForWriting= 2
strFolder= "C:\Scripts\Run"
Set FSO= CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
set FLD= FSO.GetFolder(strFolder)
'loop through the folder and get the files
For Each Fil In FLD.Files
'Open the file to read
Set TS= FSO.OpenTextFile(fil.Path, ForReading)
'Read the contents into a variable
strContent= TS.ReadAll
'Close the file
TS.Close
reDim arrMR(1,1)
arrMR(0,0)= "(\s+)(<Start_Date>(.*?)<\/Start_Date>)"
arrMR(1,0)= "(\s+)(<End_Date>(.*?)<\/End_Date>)"
For i= 0 to Ubound(arrMR)
objRegEx.Pattern= arrMR(i,0)
Set objMatches= objRegEx.Execute(strContent)
d=0
For Each objMatch in objMatches
If i= 0 Then
If d>0 Then
reDim Preserve arrStart(d)
Else
reDim arrStart(d)
End If
arrStart(d)= objMatches.Item(d).SubMatches(2)
'Wscript.Echo arrStart(d)
ElseIf i<> 0 Then
If d>0 Then
reDim Preserve arrEnd(d)
ReDim Preserve arrMatch1(d)
Else
reDim arrEnd(d)
ReDim arrMatch1(d)
End If
arrEnd(d)= objMatches.Item(d).SubMatches(2)
arrMatch1(d)= objMatches.Item(d).SubMatches(1)
End If
If objRegEx.Pattern<> arrMR(0,0) Then
If (ubound(arrStart)= ubound(arrEnd)) Then
'Wscript.Echo "Ubounds Match"
Parse strContent
strContent= Parse(strContent)
Else
'Wscript.Echo "Start & End Dates do not match"
End If
End If
d= d+ 1 'increment to next match
Next
Next
'Close the file
TS.Close
'Open the file to overwrite the contents
Set TS= FSO.OpenTextFile(fil.Path, ForWriting)
'Write the contents back
TS.Write strContent
'Close the current file
TS.Close
Next
'Clean up
Set TS= Nothing
Set FLD= Nothing
Set FSO= Nothing
Function Parse(ParseContent)
'Dim sFSpec : sFSpec = FSO.GetAbsolutePathName("C:\Users\j.levine\Desktop\XML Feeder Scripts\Test_Files\monvid.txt")
Dim oXML : Set oXML = CreateObject("Msxml2.DOMDocument.6.0")
Dim strXMLSDat, strXMLarrStartD, XMLEDat
oXML.setProperty "SelectionLanguage", "XPath"
oXML.async = False
oXML.loadXML(ParseContent)
If 0 = oXML.parseError Then
Dim sXPath3 : sXPath3 = "//XMLFeederRoot/Ad[End_Date=Start_Date]"
Dim ndlFnd : Set ndlFnd = oXML.selectNodes(sXPath3)
If 0 = ndlFnd.length Then
WScript.Echo sXPath, "not found"
ElseIf 0<> ndlFnd.length Then
'WScript.Echo "found", ndlFnd.length, "nodes for", sXPath
Dim ndCur, oldNode
For Each ndCur In ndlFnd
oldNode = oXML.selectsinglenode("//End_Date").text
oldNode= XMLSplitArray(oldNode) 'Pass current Date into Array and add 30 days & return as node text
Set newNode= oXML.selectSingleNode("//End_Date")
newNode.text= oldNode
WScript.Echo ndCur.xml
Next
'WScript.Echo "We have nothing to replace"
End If
Else
WScript.Echo oXML.parseError.reason
End If
Parse= ParseContent
End Function
Function XMLSplitArray(strval1)
dim XmlSA, XmlSA2, XMLEDat
XmlSA = split(strval1, "-")
XmlSA(2) = Left(XmlSA(2), 2)
strXMLDate = XmlSA(1) & "/" & XmlSA(2) & "/" & XmlSA(0)
strXMLDate30 = DateAdd("d", 30, strXMLDate)
XmlSA2 = split(strXMLDate30, "/")
'Add zero to the left
XmlSA2(0)= Right("0" & XmlSA2(0), 2)
XmlSA2(1)= Right("0" & XmlSA2(1), 2)
XmlSA2(1) = XmlSA2(1) & "T00:00:00"
XMLEDat = XmlSA2(2) & "-" & XmlSA2(0) & "-" & XmlSA2(1)
XMLSplitArray= XMLEDat
End Function
Thomas was right w/ the KISS method. I took a big step back, and started over.
Here's what I've come up with. It does what I need regarding the Date+30 and writing back to a file. I think this method is cleaner and will allow me to run my other text massaging through functions.
My questions about this new script are:
1. can this be done without having to write to a new file? Keeping to 1 file is easier.
2. Can I avoid cloning the node and deleting the original one and directly change the original node's value?
3. I seem to be missing how to get that last node <Status> onto it's own line.
Script:
Dim xmlDoc: Set xmlDoc = CreateObject("Msxml2.DOMDocument")
xmlDoc.Async = False
xmlDoc.load "C:\Scripts\Run\MonVid-SHORT.xml"
Dim xmldoc2: set xmldoc2 = CreateObject("Msxml2.DOMDocument")
Dim strSkeleton : strSkeleton= "<?xml version=""1.0"" encoding=""utf-8""?>" & _
"<XMLFeederRoot>" & _
"</XMLFeederRoot>"
xmldoc2.loadXML(strSkeleton)
xmldoc2.save "C:\Scripts\Copy\New_MonVid-Short.xml"
xmlDoc2.async = False
xmlDoc2.load "C:\Scripts\Copy\New_MonVid-Short.xml"
Dim sXPath : sXPath = "/XMLFeederRoot/Ad[Start_Date=End_Date]"
For Each n In XMLDoc.SelectNodes(sXpath)
set l = n.cloneNode(True)
q= l.selectSingleNode("/End_Date").text
strSDat=SplitArray(q)
l.removeChild(l.childNodes.item(2))
set Stat= l.selectSingleNode("/Status")
set Parent= Stat.parentNode
set EDate= xmlDoc2.createElement("End_Date")
EDate.appendChild xmlDoc2.createTextNode(strSDat)
Parent.insertBefore EDate, Stat
xmldoc2.documentElement.appendChild parent
Next
xmlDoc2.save xmldoc2.url
Function SplitArray(strval1)
dim SplitArray1, SplitArray2, strSDat
splitArray1 = split(strval1, "-")
splitArray1(2) = left(splitArray1(2), 2)
strDate1 = SplitArray1(1) & "/" & SplitArray1(2) & "/" & SplitArray1(0)
strDate30 = DateAdd("d", 30, strDate1)
SplitArray2 = split(strDate30, "/")
'Add zero to the left
If Len(SplitArray2(0))<2 Then
SplitArray2(0)= Right("0" & SplitArray2(0), 2)
End If
If Len(SplitArray2(1))<2 Then
SplitArray2(1)= Right("0" & SplitArray2(1), 2)
End If
SplitArray2(1) = splitArray2(1) & "T00:00:00"
strSDat = SplitArray2(2) & "-" & SplitArray2(0) & "-" & SplitArray2(1)
SplitArray= strSDat
End Function
Output File:
<?xml version="1.0" encoding="utf-8"?>
<XMLFeederRoot><Ad>
<Ad_Number>d00524224</Ad_Number>
<Start_Date>2016-08-20T00:00:00</Start_Date>
<End_Date>2016-09-19T00:00:00</End_Date><Status>Run</Status>
</Ad><Ad>
<Ad_Number>d00524225</Ad_Number>
<Start_Date>2016-08-20T00:00:00</Start_Date>
<End_Date>2016-09-19T00:00:00</End_Date><Status>Run</Status>
</Ad>
</XMLFeederRoot>
Since Text and XML files don't use file locks by default just overwrite the original file using xmlDoc.Save monvidPath.
Sub setAdEndDate(monvidPath)
Const sXPath = "/XMLFeederRoot/Ad/End_Date"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(monvidPath)
Set colNodes=xmlDoc.selectNodes(sXPath)
For Each n In colNodes
n.Text = SplitArray(n.Text)
Next
xmlDoc.Save monvidPath
End Sub
Function SplitArray(strval1)
Dim SplitArray1, SplitArray2, strSDat
splitArray1 = Split(strval1, "-")
splitArray1(2) = Left(splitArray1(2), 2)
strDate1 = SplitArray1(1) & "/" & SplitArray1(2) & "/" & SplitArray1(0)
strDate30 = DateAdd("d", 30, strDate1)
SplitArray2 = Split(strDate30, "/")
'Add zero to the left
If Len(SplitArray2(0))<2 Then
SplitArray2(0)= Right("0" & SplitArray2(0), 2)
End If
If Len(SplitArray2(1))<2 Then
SplitArray2(1)= Right("0" & SplitArray2(1), 2)
End If
SplitArray2(1) = splitArray2(1) & "T00:00:00"
strSDat = SplitArray2(2) & "-" & SplitArray2(0) & "-" & SplitArray2(1)
SplitArray= strSDat
End Function
You can find examples of code on how to fetch weather data using PHP, Ruby, Python, ColdFusion, and jQuery here: http://www.wunderground.com/weather/api/d/docs?d=resources/code-samples, I was wondering if there was an equivalent of this regarding VBScript that someone was aware of.
I have a very limited understanding of VB, no less VBS, but I found this code online which seems like it might work:
Option Explicit
'On Error Resume Next
Dim objXML, strXMLFile, weatherFor, weatherCondition, currTemp, highTemp, lowTemp
strXMLFile = "C:\Temp\test.xml"
Set objXML = CreateObject("Microsoft.XMLDOM")
objXML.async = "False"
objXML.load(strXMLFile)
weatherFor = objXML.getElementsByTagName("yweather:location").item(0).attributes.getNamedItem("city").value
weatherCondition = objXML.getElementsByTagName("yweather:condition").item(0).attributes.getNamedItem("text").value
currTemp = objXML.getElementsByTagName("yweather:condition").item(0).attributes.getNamedItem("temp").value
highTemp = objXML.getElementsByTagName("yweather:forecast").item(0).attributes.getNamedItem("high").value
lowTemp = objXML.getElementsByTagName("yweather:forecast").item(0).attributes.getNamedItem("low").value
WScript.Echo weatherFor
WScript.Echo weatherCondition
WScript.Echo currTemp
WScript.Echo highTemp
WScript.Echo lowTemp
But when I try to execute it I get the error: Object required: getElementsByTagName(...).item(...)
I've looked it up and this is the problem: http://www.computerperformance.co.uk/Logon/code/code_800A01A8.htm, but I'm not sure what to make of it.
Does someone know how to solve this error code, or a better way to do this altogether? Thank you very much in advance.
[Edit:]
Here's some working code:
Dim WeatherRSS
WeatherRSS = "http://weather.yahooapis.com/forecastrss?p=CAXX0773&u=c"
Dim WinHttpReq, XMLData, objXML, weatherCity, weatherCondition, currTemp, highTemp, lowTemp
Dim Response, Talker
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
WinHttpReq.Open "GET", WeatherRSS, False
WinHttpReq.Send
If (WinHttpReq.Status = 200) Then
XMLData = WinHttpReq.ResponseText
Set objXML = CreateObject("Microsoft.XMLDOM")
objXML.async = "False"
objXML.loadXML(XMLData)
weatherCity = objXML.getElementsByTagName("yweather:location").item(0).attributes.getNamedItem("city").value
weatherCondition = objXML.getElementsByTagName("yweather:condition").item(0).attributes.getNamedItem("text").value
currTemp = objXML.getElementsByTagName("yweather:condition").item(0).attributes.getNamedItem("temp").value
highTemp = objXML.getElementsByTagName("yweather:forecast").item(0).attributes.getNamedItem("high").value
lowTemp = objXML.getElementsByTagName("yweather:forecast").item(0).attributes.getNamedItem("low").value
weather = weatherCondition & " " & currTemp & " " & highTemp & " " &
lowTemp & " " + weatherCity & "."
else weather = "Sorry, I can't predict the weather today."
end if
msgbox(weather)