I have inherited an Excel Tracker sheet and the code originally was created by someone else who has since left the company.
We have an Excel VBA Tracker sheet which communicates with Jira and used to work fetching projects and issues without any issues until our company changed from site minder for cookies to "Isolated Site Minder" for more secure cookies, since the change over to the isolated site minder cookie authentication our Excel tracker sheet will fetch the project key from Jira without any problem but it brings the same list of 50 issues no matter which project we are querying Jira for and no matter how we change the code it wont see the issue "Key" and filter and fetch the correct issues for the project. I'm not brilliant as Excel VBA but I do understand and can follow what the code is doing and make small adjustments, but I have now inherited this tracker sheet and am not very good at the Jira code and communicating with each other
the code is as follows:
Public Function httpGet (ByVal url as String) As String()
Dim resultArray(2) as String
Dim PostData as String
url = baseurl + url
Dim smiwhr As New SMIsolatedWinHttpRequest
With CreateObject("WinHTTP.WinHTTPrequest.5.1")
.Option(WinRequestOption_EnableRedirects) = True
.Option(WinRequestOption_EnableHttpsToHttpRedirects) = True
smiwhr.NewRequest "GET", url
smiwhr.Send PostData
.Open "GET", url, False
.SetRequestHeader "Content-Type", "Application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Cookie", sCookie
.Send
resultArray(0) = Status
resultArray(1) = .ResponseText
End With
httpGet = resultArray
End Function
There is a function that gets the requests which has the code:
Public Function getRequestByPaging(ByVal projectKey as String, ByVal StartIndex as Integer, Optional maxResults As Integer, Optional fields As String) As Object
Dim resultArray() As String
Dim api as String
Dim jql As String
Dim PostData As String
api = "rest/api/2/search"
jql = "project=" & projectKey & " and issuetype!=\""Project\"" ORDER By Key ASC "
PostData = "{"
PostData = PostData + toJson ("jql", jql) + ","
PostData = PostData + toJson("StartAt", StartIndex) + ","
If maxResults <> "" Then
PostData = PostData + toArray("field", fields) + ","
End If
PostData = Mid(PostData, 1, Len(PostData) - 1)
PostData = Post + "}"
End Function
The jql part does pick up the project key, it is when it sends the details of the project through to the Json that it returns the wrong issue key
The Json function is as follows:
Public Function toJson (byVal As String, ByVal value As String) As String
If value = "" Then
toJson = """" + key + """ : null"
Else
toJson = """" + key + """ : """ + value + """"
End If
End Function
Any help would be very much appreciated
While editing your original question and adding syntax highlighting to it (otherwise your code cannot be read), I've noticed that the syntax in the function in question is probably wrong:
You had it:
If value = "" Then
toJson = """ + key + """ : null"
' ^^^ missing "
Else
toJson = """" + key + """ : """ + value """"
' ^ missing +
End If
It should be this way:
If value = "" Then
toJson = """" + key + """ : null"
Else
toJson = """" + key + """ : """ + value + """"
End If
Related
I'm very new to API coding but I have created an API Code that inputs pressure and outputs temperature for a specific refrigerant on a website. However, I can only call for one refrigerant at a time, I was wondering if it is possible to create a string with all the refrigerant id (refId) numbers, so the API code could run through all of them in one long run?
Option Explicit
Public Function GetPressureFromTemp(ByVal Temperature As Double) As Double
Dim body As String
body = "{""Temperature"":""" & Temperature & """,""refId"":""r13"",""temperatureUnit"":""fahrenheit"",""pressureUnit"":""psi"","
body = body & """pressureReferencePoint"":""gauge"","
body = body & """pressureCalculationPoint"":""bubble"",""gaugeType"":""dry"",""altitudeInMeter"":0}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://reftools.danfoss.com/api/ref-slider/Pressure?refId=r13", False
.setRequestHeader "content-type", "application/json; charset=utf-8"
.send body
GetPressureFromTemp = CDbl(.responseText)
End With
End Function
Public Sub test()
Dim n As Double
Dim a As Double
a = 4984
n = -150.8
Do Until n >= 74.93
n = n + 0.1
'Debug.Print GetPressureFromTemp(n)
Range("J" & a) = GetPressureFromTemp(n)
a = a + 1
Loop
End Sub
I'm not sure how to loop through each ref ID, however I have the whole list containing the refrigerant id
To make sure an address is always formatted the same way (which I will use in another VBA Sub), I'm trying to use the Google Places API in combination with a created VBA function.
The query works in the browser but not from the created function.
The working API (temporary API-key added) with a random address: https://maps.googleapis.com/maps/api/place/findplacefromtext/json?fields=formatted_address%2Cname%2Crating%2Copening_hours%2Cgeometry&input=Coendersweg%202&inputtype=textquery&key=API_KEY
It gives "Formatted_Address" which I'd like to show up as the result of the function.
Example result of random address:
Coendersweg 2, 9722GE Groningen / [Streetname number, Zipcode City]
If it's possible to make resulting address have the zip code (9722 GE) formatted as "9722GE" and the country ", Nederland" not show up that would be even better.
VBA code I have so far:
Function FindAddress(address, APIKEY)
Dim strURL As String
strURL = "https://maps.googleapis.com/maps/api/place/findplacefromtext/" & _
"json?fields=formatted_address%2Cname%2Crating%2Copening_hours%2Cgeometry&input=" _
& address & "&inputtype=textquery&key=" & APIKEY
Set httpReq = CreateObject("MSXML2.XMLHTTP")
With httpReq
.Open "GET", strURL, False
.Send
End With
Dim Response As String
Response = httpReq.ResponseText
Dim parsed As Dictionary
Set parsed = JsonConverter.ParseJson(Response)
Dim FoundAddress As String
FoundAddress = (formatted_address)
FindAddress = FoundAddress
I've the "JsonConverter.bas" from https://github.com/VBA-tools/VBA-JSON as a module inside my VBA.
Most of the code is borrowed from the following YouTube video. I made some tweaks to work with Google Places API instead of Google Directions API:
https://www.youtube.com/watch?v=_P2lj4yHNu4.
Here's a method that will return the formatted_address field. You can return other fields if you prefer -- the modifications should be obvious.
Note that I used early binding, but you can use late binding if you prefer.
Run against your input, => Coendersweg 2, 9722 GE Groningen, Netherlands
Option Explicit
Function getAddress(S As String)
Const API As String = "key=YOUR_API_KEY"
Const sURL1 As String = "https://maps.googleapis.com/maps/api/place/findplacefromtext/json?fields=formatted_address"
Const sURL2 As String = "input="
Const sURL3 As String = "inputtype=textquery"
Dim sAddr As String
Dim sURL() As String
Dim sLocation As String
Dim xhrRequest As XMLHTTP60
Dim strJSON As String, JSON As Object
sAddr = Replace(S, " ", "%20")
'Many ways to create the URL to send
ReDim sURL(3)
sURL(0) = sURL1
sURL(1) = sURL2 & sAddr
sURL(2) = sURL3
sURL(3) = API
Set xhrRequest = New XMLHTTP60
With xhrRequest
.Open "Get", Join(sURL, "&"), False
.Send
strJSON = .ResponseText
End With
Set JSON = ParseJson(strJSON)
If Not JSON("status") = "OK" Then
MsgBox "Status message: " & JSON("status")
Exit Function
End If
'might need to check if more than one candidate is returned
getAddress = JSON("candidates")(1)("formatted_address")
End Function
If you want to have the format different from what is shown, I suggest you use the Places api to return the place_id. You can then feed that value into the Place Details to return the address_components and format the address however you prefer.
I'm trying to setup a API connector with my Binance account and have come across the below code (which I found here: https://github.com/krijnsent/crypto_vba/blob/master/ModExchBinance.bas) which I can't seem to tweak to provide the information I need (for one, the WebRequestURL() function isn't something I'm even familiar with)... Basically what I need is to be pointed in the right direction for some sample code.
Has anyone gone though this to fully automate the API whereby buy/sells are triggered in certain conditions and, if not, even parse the information (volume, open, High, Low, Close etc.) on 5 minute candles and it can prompt me to place the trades manually.
Code I have:
Sub TestBinance()
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
Dim apikey As String
Dim secretkey As String
apikey = "your api key here"
secretkey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
apikey = apikey_binance
secretkey = secretkey_binance
Debug.Print PublicBinance("time", "")
'{"serverTime":1513605418615}
Debug.Print PublicBinance("ticker/24hr", "?symbol=ETHBTC")
'{"symbol":"ETHBTC","priceChange":"0.00231500","priceChangePercent":"6.345","weightedAvgPrice":"0.03788715","prevClosePrice":"0.03648400","lastPrice":"0.03880200","lastQty":"0.29800000","bidPrice":"0.03873300","bidQty":"10.00000000","askPrice":"0.03883100","askQty":"17.18000000","openPrice":"0.03648700","highPrice":"0.04000000","lowPrice":"0.03631200","volume":"274355.20000000","quoteVolume":"10394.53526717","openTime":1513522564335,"closeTime":1513608964335,"firstId":7427497,"lastId":7702400,"count":274904}
Debug.Print GetBinanceTime()
'e.g. 1516565004894
'Unix time period:
t1 = DateToUnixTime("1/1/2014")
t2 = DateToUnixTime("1/1/2018")
Debug.Print PrivateBinance("account", apikey, secretkey)
'{"makerCommission":10,"takerCommission":10,"buyerCommission":0,"sellerCommission":0,"canTra etc...
Debug.Print PrivateBinance("order/test", apikey, secretkey, "symbol=LTCBTC&side=BUY&type=LIMIT&price=0.01&quantity=1&timeInForce=GTC")
'{} -> test orders return empty JSON
End Sub
Function PublicBinance(Method As String, Optional MethodOptions As String) As String
'https://binance.com/home/api
Dim Url As String
PublicApiSite = "https://api.binance.com"
urlPath = "/api/v1/" & Method & MethodOptions
Url = PublicApiSite & urlPath
PublicBinance = WebRequestURL(Url, "GET")
End Function
Function PrivateBinance(Method As String, apikey As String, secretkey As String, Optional MethodOptions As String) As String
Dim NonceUnique As String
Dim TimeCorrection As Long
'https://binance.com/home/api
'Get a 13-digit Nonce -> use the GetBinanceTime() to avoid a time correction
NonceUnique = GetBinanceTime() + 1000
TradeApiSite = "https://api.binance.com/api/v3/"
postdata = MethodOptions & "×tamp=" & NonceUnique
APIsign = ComputeHash_C("SHA256", postdata, secretkey, "STRHEX")
Url = TradeApiSite & Method & "?" & postdata & "&signature=" & APIsign
'Binance requires a POST for orders, other commands are GETs
If InStr(Method, "order") > 0 Then
HTTPMethod = "POST"
Else
HTTPMethod = "GET"
End If
' Instantiate a WinHttpRequest object and open it
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open HTTPMethod, Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "X-MBX-APIKEY", apikey
objHTTP.Send get_url
objHTTP.WaitForResponse
PrivateBinance = objHTTP.ResponseText
Set objHTTP = Nothing
End Function
Function GetBinanceTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicBinance time
JsonResponse = PublicBinance("time", "")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetBinanceTime = Json("serverTime")
Set Json = Nothing
End Function
I am tying to set-up a Excel VBA project to readout individual survey responses into a form in Excel for some calculations and then PDF reporting.
However I have great difficulty to deploy the .NET library (SurveyMonkeyApi) to be available for reference in VBA.
I have set up a VisualStudio project to test that way , and I can install it for that specific VS project (through NuGet PM). But the library is not made available for Excel on that machine.
I have downloaded (on another machine) the libraries through standalone NuGet and they download OK but then I am at loss on how to register for Excel VBA access. On top of it there is a dependency on NewtonsoftJson library too (which downloaded automatically on both occasions).
Good advice appreciated!
I just saw this now - is there a feature for StackOverflow to alert me when a comment is added or a question answered, so I know to look back?
Here is starting code:
Option Explicit
Public Const gACCESS_TOKEN As String = "xxxxxxxxxxxxxxxxxxxxxx"
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
' for a JSON parser see https://code.google.com/p/vba-json/
Public Sub test()
Dim vRequestBody As Variant, sResponse As String, sSurveyID As String
sSurveyID = "1234567890"
vRequestBody = "{""survey_id"":" & """" & sSurveyID & """" _
& ", ""fields"":[""collector_id"", ""url"", ""open"", ""type"", ""name"", ""date_created"", ""date_modified""]" _
& "}"
sResponse = SMAPIRequest("get_collector_list", vRequestBody)
End Sub
Function SMAPIRequest(sRequest As String, vRequestBody As Variant) As String
Const SM_API_URI As String = "https://api.surveymonkey.net/v2/surveys/"
Const SM_API_KEY As String = "yyyyyyyyyyyyyyyyyyyyyyyy"
Dim bDone As Boolean, sMsg As String, sUrl As String, oHttp As Object ' object MSXML2.XMLHTTP
Static lsTickCount As Long
If Len(gACCESS_TOKEN) = 0 Then
Err.Raise 9999, "No Access token"
End If
On Error GoTo OnError
sUrl = SM_API_URI & URLEncode(sRequest) & "?api_key=" & SM_API_KEY
'Debug.Print Now() & " " & sUrl
Application.StatusBar = Now() & " " & sRequest & " " & Left$(vRequestBody, 127)
Set oHttp = CreateObject("MSXML2.XMLHTTP") ' or "MSXML2.ServerXMLHTTP"
Do While Not bDone ' 4.33 offer retry
If GetTickCount() - lsTickCount < 1000 Then ' if less than 1 sec since last call, throttle to avoid sResponse = "<h1>Developer Over Qps</h1>"
Sleep 1000 ' wait 1 second so we don't exceed limit of 2 qps (queries per second)
End If
lsTickCount = GetTickCount()
'Status Retrieves the HTTP status code of the request.
'statusText Retrieves the friendly HTTP status of the request.
'Note The timeout property has a default value of 0.
'If the time-out period expires, the responseText property will be null.
'You should set a time-out value that is slightly longer than the expected response time of the request.
'The timeout property may be set only in the time interval between a call to the open method and the first call to the send method.
RetryPost: ' need to do all these to retry, can't just retry .Send apparently
oHttp.Open "POST", sUrl, False ' False=not async
oHttp.setRequestHeader "Authorization", "bearer " & gACCESS_TOKEN
oHttp.setRequestHeader "Content-Type", "application/json"
oHttp.send CVar(vRequestBody) ' request body needs brackets EVEN around Variant type
'-2146697211 The system cannot locate the resource specified. => no Internet connection
'-2147024809 The parameter is incorrect.
'String would return {"status": 3, "errmsg": "No oJson object could be decoded: line 1 column 0 (char 0)"} ??
'A Workaround would be to use parentheses oHttp.send (str)
'"GET" err -2147024891 Access is denied.
'"POST" Unspecified error = needs URLEncode body? it works with it but
SMAPIRequest = oHttp.ResponseText
'Debug.Print Now() & " " & Len(SMAPIRequest) & " bytes returned"
sMsg = Len(SMAPIRequest) & " bytes returned in " & (GetTickCount() - lsTickCount) / 1000 & " seconds: " & sRequest & " " & Left$(vRequestBody, 127)
If Len(SMAPIRequest) = 0 Then
bDone = MsgBox("No data returned - do you wish to retry?" _
& vbLf & sMsg, vbYesNo, "Retry?") = vbNo
Else
bDone = True ' got reply.
End If
Loop ' Until bdone
Set oHttp = Nothing
GoTo ExitProc
OnError: ' Pass True to ask the user what to do, False to raise to caller
Select Case MsgBox(Err.Description, vbYesNoCancel, "SMAPIRequest")
Case vbYes
Resume RetryPost
Case vbRetry
Resume RetryPost
Case vbNo, vbIgnore
Resume Next
Case vbAbort
End
Case Else
Resume ExitProc ' vbCancel
End Select
ExitProc:
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long
StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
EDIT 23-APRIL add more code.
the Me. comes from code in a Userform.
Set jLib = New JSONLib
vRequestBody = "{"
If Me.txtDaysCreated > "" Then
vRequestBody = vRequestBody & JKeyValue("start_date", Format$(Now() - CDbl(Me.txtDaysCreated), "yyyy-mm-dd")) & ","
End If
If Me.txtTitleContains > "" Then
' title contains "text", case insensitive
vRequestBody = vRequestBody & JKeyValue("title", Me.txtTitleContains) & ","
End If
vRequestBody = vRequestBody _
& JKeyValue("fields", Array("title", "date_created", "date_modified", "num_responses", _
"language_id", "question_count", "preview_url", "analysis_url")) & "}"
'returns in this order: 0=date_modified 1=title 2=num_responses 3=date_created 4=survey_id
' and in date_created descending
sResponse = GetSMAPIResponse("get_survey_list", vRequestBody)
------------------------------------------
Function JKeyValue(sKey As String, vValues As Variant) As String
Dim jLib As New JSONLib
JKeyValue = jLib.toString(sKey) & ":" & jLib.toString(vValues)
Set jLib = Nothing
End Function
Edit 25-April overview of VBA code to get the data
This is covered in the SM documentation, but I'll sketch how that looks in VBA.
the response to get_survey_details gives you all the survey setup data. Use
Set oJson = jLib.parse(Replace(sResponse, "\r\n", " "))
to get a json object.
Set dictSurvey = oJson("data")
gives you the dictionary so you can get data like dictSurvey("num_responses"). I take it you know how to index into dictionary objects to get field values.
Set collPages = dictSurvey("pages")
gives you a collection of Pages. The undocumented field "position" gives you the order of pages in the survey UI.
For lPage = 1 To collPages.Count
Set dictPage = collPages(lPage)
Set collPageQuestions = dictPage("questions") ' gets you the Qs on this page
For lPageQuestion = 1 To collPageQuestions.Count
Set dictQuestion = collPageQuestions(lPageQuestion) ' gets you one Q
Set collAnswers = dictQuestion("answers") ' gets the QuestionOptions for this Q
For lAnswer = 1 To collAnswers.Count
Set dictAnswer = collAnswers(lAnswer) ' gets you one Question Option
etc etc
Then given the number of responses from above, loop through the respondents 100 at a time - again see the SM doc for details of how to specify start and end dates to do incremental downloads over time.
create a json object from the response to "get_respondent_list"
Collect the fields for each respondent and accumulate a list of at most 100 respondent IDs.
Then "get_responses" for that list.
Set collResponsesData = oJson("data")
For lResponse = 1 To collResponsesData.Count
If not IsNull(collResponsesData(lResponse)) then
... get fields...
Set collQuestionsAnswered = collResponsesData(lResponse)("questions")
For lQuestion = 1 To collQuestionsAnswered.Count
Set dictQuestion = collQuestionsAnswered(lQuestion)
nQuestion_ID = CDbl(dictQuestion("question_id"))
Set collAnswers = dictQuestion("answers") ' this is a collection of dictionaries
For lAnswer = 1 To collAnswers.Count
On Error Resume Next ' only some of these may be present
nRow = 0: nRow = CDbl(collAnswers(lAnswer)("row"))
nCol = 0: nCol = CDbl(collAnswers(lAnswer)("col"))
nCol_choice = 0: nCol_choice = CDbl(collAnswers(lAnswer)("col_choice"))
sText = "": sText = collAnswers(lAnswer)("text")
nValue = 0: nValue = Val(sText)
On Error GoTo 0
and save all those values in a recordset or sheet or whatever
Hope that helps.
I access the SM API in straight VBA.
Just CreateObject("MSXML2.XMLHTTP") then issue calls and use the SimpleJsON JSONLib to parse it.
If I wanted to access VB.Net code, I'd package it with ExcelDNA to create a XLL and that gives a straight Excel addin.
I would think you would need to add it into the References for your Excel project.
From the Ribbon, select, Tools, then References, then scroll through the list looking for something about SurveyMonkey API.
So encouraged by #sysmod I have tried to do something in VBA directly. I have left out the JSON for now as I am already in trouble. The below is giving me "Developer Inactive" as a result, though I have another project in VB.NET where the same key and token works fine.
Public Sub GetSMList()
Dim apiKey As String
Dim Token As String
Dim sm As Object
apiKey = "myKey"
Token = "myToken"
Set sm = CreateObject("MSXML2.XMLHTTP.6.0")
With sm
.Open "POST", "https://api.surveymonkey.net/v2/surveys/get_survey_list", False
.setRequestHeader "Authorization", "Bearer " & Token
.setRequestHeader "Content-Type", "application/json"
.send "api_key=" & apiKey
result = .responseText
End With
End Sub
On the button click in my web page i run an sql statement, I also want to run a web request. I do not want to load anything from the web request, jsut run it. but here is the funny thing. The code that is the sql statement runs jsut fine, and then everything else below it just seems to not run.... at all. the server never receives the web request.
if i copy the code to a page and run just the web request code it works. but here it does not.
asp.net. thanks everyone. im stumped.
Imports System
Imports System.Data
Imports System.Web
Imports System.Data.SqlClient
Imports System.IO
Imports System.Net
Imports System.Text
Partial Class _Default
Inherits System.Web.UI.Page
Protected Sub btnAddDeckSize_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAddDeckSize.Click
If txtDeckSize.Text > "" And txtNewDeckPrice.Text > "" Then
Dim WasError As Boolean = False
Dim SQLstring As String = "Server=server;Database=SecondLifeDatabases;Integrated Security=true"
Dim SQLconn As SqlConnection
Dim SQLcmd As New SqlCommand()
SQLconn = New SqlConnection(SQLstring)
Try
SQLconn.Open()
SQLcmd.Connection = SQLconn
Try
SQLcmd.CommandText = ("INSERT INTO [SecondLifeDatabases].[dbo].[YuGiOh-DecksAndPrices]([DeckSize] ,[PriceInLindins])VALUES (" + txtDeckSize.Text + "," + txtNewDeckPrice.Text + ")")
SQLcmd.ExecuteNonQuery()
Catch ex As Exception
Context.Response.Write("error:" + vbCrLf + " " + vbCrLf + "Unable to insert sql data, Type:" + vbCrLf + " " + vbCrLf + ex.Message)
WasError = True
SQLconn.Close()
End Try
Catch ex As Exception
Context.Response.Write("error:" + vbCrLf + " " + vbCrLf + "Could not open database:" + vbCrLf + " " + vbCrLf + ex.Message)
WasError = True
SQLconn.Close()
End Try
SQLconn.Close()
If WasError = False Then
Context.Response.Redirect("~/YuGiOh.aspx")
End If
Else
Context.Response.Write("Please check your values, something is Missing")
End If
'START OF WHERE CODE SEEMS TO NOT RUN
'THIS CODE ALONE RUNS ON ANOTHER PAGE
'BUT HERE, EVEN THO THE CODE ABOVE RUNS,
'I NEVER SEE ANY RESULTS FROM THE CODE BLOW
' Create a request using a URL that can receive a post.
Dim request As WebRequest = WebRequest.Create("http://sim6103.agni.lindenlab.com:12046/cap/b936c974-cfab-c2ee-a184-4288fe0a10f8")
' Set the Method property of the request to POST.
request.Method = "POST"
' Create POST data and convert it to a byte array.
Dim postData As String = "This is a test that posts this string to a Web server."
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
' Set the ContentType property of the WebRequest.
request.ContentType = "application/x-www-form-urlencoded"
' Set the ContentLength property of the WebRequest.
request.ContentLength = byteArray.Length
' Get the request stream.
Dim dataStream As Stream = request.GetRequestStream()
' Write the data to the request stream.
dataStream.Write(byteArray, 0, byteArray.Length)
' Close the Stream object.
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Display the status.
Console.WriteLine(CType(response, HttpWebResponse).StatusDescription)
' Get the stream containing content returned by the server.
dataStream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim reader As New StreamReader(dataStream)
' Read the content.
Dim responseFromServer As String = reader.ReadToEnd()
' Display the content.
Console.WriteLine(responseFromServer)
' Clean up the streams.
reader.Close()
dataStream.Close()
response.Close()
End Sub