xmlhttp

prueba1.bas

Sub GetLatestScriptoriumPosts()
    Dim i As Integer
    Dim sURL As String, sHTML As String, sAllPosts As String
    Dim oHttp As Object
    Dim lTopicstart As Long, lTopicend As Long
    Dim blWSExists As Boolean
    
    'Create a new Worksheet "Latest Scriptorium Posts" if it doesnt'exist already.
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Latest Scriptorium Posts" Then
            blWSExists = True
            Worksheets(i).Activate
        End If
    Next
    If Not blWSExists Then
        Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "Latest Scriptorium Posts"
    End If
     
     'URL to open
    sURL = "http://scriptorium.serve-it.nl/environments.php?eid=1"
    
    ' Create an XMLHTTP object and add some error trapping
    On Error Resume Next
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then
        Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
        MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object"
    End If
    On Error GoTo 0
    If oHttp Is Nothing Then
        MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object"
        Exit Sub
    End If
    
    'Open the URL in browser object
    oHttp.Open "GET", sURL, False
    oHttp.Send
    sHTML = oHttp.responseText
        
    'Extract the desired information from the returned HTML code (text)
    'To make things a little easier I usually cut of most of the unwanted code first
    'so sHTML is smaller to work with.
    lTopicstart = InStr(1, sHTML, "Recent additions", vbTextCompare)
    lTopicend = InStr(1, sHTML, "</table>", vbTextCompare)
    sHTML = Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
    
    'Now extract all text within the hyperlinks <a href..>..</a>
    'because they represent the topics
    i = 1
    lTopicstart = 1
    lTopicend = 1
    Do While lTopicstart <> 0
        i = i + 1
        lTopicstart = InStr(lTopicend, sHTML, "<a href=", vbTextCompare)
        If lTopicstart <> 0 Then
            lTopicstart = InStr(lTopicstart, sHTML, ">", vbTextCompare) + 1
            lTopicend = InStr(lTopicstart, sHTML, "</a>", vbTextCompare)
            Worksheets(Worksheets.Count).Range("A2").Offset(i, 0).Value = _
                Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
            sAllPosts = sAllPosts & Chr(13) & Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
        End If
    Loop
    
    'Clean up
    Set oHttp = Nothing
    
    Worksheets(Worksheets.Count).Range("A1").Value = "Latest posts on Scriptorium:"
    MsgBox ("Latest posts on Scriptorium:" & Chr(13) & sAllPosts)
End Sub 

prueba2.bas

Dim objXML As MSXML2.DOMDocument

    Set objXML = New MSXML2.DOMDocument

    If Not objXML.loadXML(strXML) Then  'strXML is the string with XML'
        Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
    End If

Dim point As IXMLDOMNode
Set point = objXML.firstChild

Debug.Print point.selectSingleNode("X").Text
Debug.Print point.selectSingleNode("Y").Text

prueba3.bas

' Sending http post

Dim result As String
Dim myURL As String, postData As String
Dim winHttpReq As Object
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
 
myURL = "http://192.168.10.101:80/your_web_service"
postData = "parameter=hello¶meter2=hi"
 
winHttpReq.Open "POST", myURL, False
winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
winHttpReq.Send (postData)
 
result = winHttpReq.responseText

' Sending http get

Dim result As String
Dim myURL As String
Dim winHttpReq As Object
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
 
myURL = "http://192.168.10.101:80/your_web_service?parameter=hello¶meter2=hi"
 
winHttpReq.Open "GET", myURL, False
winHttpReq.Send
 
result = winHttpReq.responseText