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)
Related
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'm trying to write a VBScript that looks navigates a website based on the content of that website. To do that, I need to be able to assign the source code of each web page to a string variable and have the script look through that string for certain words.
I have seen this proposed as a solution:
Function GetSourceCode(url)
Set objHttp = CreateObject("Microsoft.XMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
but that does not work. I've seen elsewhere that this is possible with AutoIT, but I cannot use AutoIT per security policy.
Any ideas?
Change Microsoft.XMLHTTP to Msxml2.ServerXMLHTTP
Function GetSourceCode(url)
Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
WScript.Echo GetSourceCode("https://anothervps.com/api/phpver")
The company where I work has an old VB6 application that they want to force to use TSL, rather than SSL. I looked at the code, and told them they should be fine. The code does a post to the client website using HTTPS. It doesn't specify what encryption to use.
This is the relevant code:
Sub PostXML()
Dim XMLHttpRequest As MSXML2.XMLHTTP
Dim TempString As String
Dim strURL As String
Dim strArgs As String
strURL = gPostWebServer & "/" & gPostFile
'ARB 1/8/2004 This is to trap if send fails and allow it to continue.
On Error GoTo errorHandler:
If Not XMLHttpRequest Is Nothing Then Set XMLHttpRequest = Nothing
Set XMLHttpRequest = New MSXML2.XMLHTTP
strArgs = "?Username=" & gPostUserName & "&Password=" & gPostPassword
XMLHttpRequest.Open "POST", strURL & strArgs, False
XMLHttpRequest.send dom_GlobalXMLObject
If XMLHttpRequest.Status >= 400 And XMLHttpRequest.Status <= 599 Then
TempString = "Client Website is not available. Order was not posted successfully ..."
flgOrderPostSuccess = False
strOrderPostError = TempString
Else
TempString = XMLHttpRequest.responseText
'Parse the response
Dim sValid As String
Dim sComments As String
Dim sTimeStamp As String
Dim oRoot As MSXML2.IXMLDOMElement
Dim lNodes As MSXML2.IXMLDOMNodeList
Dim oNodes As MSXML2.IXMLDOMElement
Dim lNodes1 As MSXML2.IXMLDOMNodeList
Dim oNodes1 As MSXML2.IXMLDOMElement
Dim lNodes2 As MSXML2.IXMLDOMNodeList
Dim oNodes2 As MSXML2.IXMLDOMElement
Call Set_Global_XML_Object
dom_GlobalXMLObject.loadXML (TempString)
dom_GlobalXMLObject.Save (Report_Folder & "\Response.xml")
'Get the root of the XML tree.
Set oRoot = dom_GlobalXMLObject.documentElement
If Not oRoot Is Nothing Then
Set lNodes = oRoot.childNodes
For Each oNodes In lNodes
Select Case oNodes.nodeName
Case "Acknowledgement"
Set lNodes1 = oNodes.childNodes
For Each oNodes1 In lNodes1
Select Case oNodes1.nodeName
Case "Received"
sTimeStamp = Trim(oNodes1.nodeTypedValue)
Case "Validated"
sValid = Trim(oNodes1.nodeTypedValue)
Case "Errors"
Set lNodes2 = oNodes1.childNodes
For Each oNodes2 In lNodes2
Select Case oNodes2.nodeName
Case "Description"
sComments = sComments & vbCrLf & Trim(oNodes2.nodeTypedValue)
End Select
Set oNodes2 = Nothing
Next
Set lNodes2 = Nothing
End Select
Set oNodes1 = Nothing
Next
Set lNodes1 = Nothing
End Select
Next
If UCase(sValid) = "YES" Then
TempString = sTimeStamp & " " & "Order uploaded successfully"
flgOrderPostSuccess = True
strOrderPostError = ""
Else
TempString = "Order had following problems:" & vbCrLf
TempString = TempString & sComments
strOrderPostError = TempString
End If
Else 'Non XML response
TempString = Replace(TempString, vbCr, vbCrLf)
TempString = "Order had following problems:" & vbCrLf & TempString
strOrderPostError = TempString
End If
End If
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Set oRoot = Nothing
Set lNodes = Nothing
Set oNodes = Nothing
Set lNodes1 = Nothing
Set oNodes1 = Nothing
Set lNodes2 = Nothing
Set oNodes2 = Nothing
Set XMLHttpRequest = Nothing
Exit Sub
errorHandler:
TempString = Err.DESCRIPTION
If InStr(1, TempString, "Method") > 0 Or InStr(1, Err.DESCRIPTION, "failed") > 0 Then
TempString = "Client Website was not found. Order was not posted successfully..."
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Exit Sub
End If
End Sub
When the client switched from SSL to TSL last weekend, everything worked, except the posts from this one old VB6 app. (So I'm told, anyways. This isn't an application I've supported before.)
We have other VB6 apps that I maintain, but none do a POST out of VB6. All of them use BizTalk for posting.
The client has given us until next Wednesday to fix our app. So, the powers that be want me to force the app to use TSL.
Normally, I don't have problems with VB6, but I've never tried forcing the encryption used to POST. Generally, when we did POST out of the other VB6 apps, they negotiated with Windows on their own, and took care of things. While I've seen successful attempts to force VB6 to use TSL when sending an email, I've never seen anyone do it for POSTing.
All that being said, does anyone know how to force VB6 to use TSL when POSTing?
Thanks
With SChannel you cannot control available/used protocols and ciphers at an application level, you have to configure SChannel protocols/ciphers on the Win2003 box at system level. Here is KB on the subject: http://support.microsoft.com/kb/245030
To disable SSLv3 for both inbound and outbound connections merge something like this in registry (and reboot):
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Client]
"DisabledByDefault"=dword:00000001
"Enabled"=dword:00000000
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Server]
"Enabled"=dword:00000000
"DisabledByDefault"=dword:00000001
While there make sure SSLv2 is nuked too.
You might prefer to use IISCrypto -- a nice utility that makes SSL/TLS protocols/ciphers registry config trivial.
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
I want to write a VBS macro to auto generate an email in outlook and attach a word document. I currently have a macro that does this for excel, but I can't get it to work for Word. I can't figure out for the life of me what my "FName= " should be. Any suggestions or help would be greatly appreciated. Here is what I have:
Sub AutoEmail()
On Error GoTo Cancel
Dim Resp As Integer
Resp = MsgBox(prompt:=vbCr & "Yes = Review Email" & vbCr & "No = Immediately Send" & vbCr & "Cancel = Cancel" & vbCr, _
Title:="Review email before sending?", _
Buttons:=3 + 32)
Select Case Resp
'Yes was clicked, user wants to review email first
Case Is = 6
Dim myOutlook As Object
Dim myMailItem As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWord & "\" & ActiveWord.Name
With otlNewMail
.To = ""
.CC = ""
.Subject = ""
.Body = "Good Morning," & vbCr & vbCr & "" & Format(Date, "MM/DD") & "."
.Attachments.Add FName
.Display
End With
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If no is clicked
Case Is = 7
Dim myOutlok As Object
Dim myMailItm As Object
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = ""
.CC = ""
.Subject = ""
.Body = "Good Morning," & vbCr & vbCr & " " & Format(Date, "MM/DD") & "."
.Attachments.Add FName
.Send
'.Display
'Application.Wait (Now + TimeValue("0:00:01"))
'Application.SendKeys "%s"
End With
'otlApp.Quit
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'If Cancel is clicked
Case Is = 2
Cancel:
MsgBox prompt:="No Email has been sent.", _
Title:="EMAIL CANCELLED", _
Buttons:=64
End Select
End Sub
May it is a bit late, but I want to solve it for future use.
You want to have the active document as your file name (FName).
FName = Application.ActiveDocument.Path + "\" + Application.ActiveDocument.Name
' .Path returns only the Path where the file is saved without the file name like "C:\Test"
' .Name returns only the Name of the file, including the current type like "example.doc"
' Backslash is needed because of the missing backslash from .Path
otlNewMail.Attachements.Add FName
May you also want to save your current document before sending it via outlook, otherwise you will send the document without the changes made.
Function SaveDoc()
ActiveDocument.Save
End Function
I hope that this will help others, because the code from the question helped me a lot while scripting a similar script.