None

none
 avatar
unknown
plain_text
4 years ago
1.4 kB
4
Indexable
'Loop cada fila y print id + nombre
Sub printEIDs()
On Error Resume Next
'go to first record
If Not rst.BOF Then rst.MoveFirst

Dim i As Integer
Dim st, en As Date
i = 0
    st = Now()
    While Not rst.EOF
        Debug.Print i & "    "; rst.fields(7).Value & ": " & gethttpseid(rst.fields(7).Value)
        rst.MoveNext
        i = i + 1
    Wend
    
    en = Now()
    rst.MovePrevious
End Sub


'Rquest http
Public Function gethttpseid(id As String)
    Dim XMLHTTP As New MSXML2.XMLHTTP60, myurl As String
    Dim fromPos, toPos As Integer
    Dim response As String
    
    myurl = "https://ts.accenture.com/sites/PCSArgentina/PCSPortal/PMO_Automation/_layouts/15/userdisp.aspx?ID=" & id
    XMLHTTP.Open "POST", myurl, False
    XMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    XMLHTTP.Send
    
    'get position from the first title tag
    fromPos = InStr(1, XMLHTTP.responseText, "<title>") + 7
    'Get position from the closing title tag
    toPos = InStr(fromPos, XMLHTTP.responseText, "</title>")
    
    'get the values from the title tag
    response = Mid(XMLHTTP.responseText, fromPos, toPos - fromPos)
    
    'clean output
    response = Replace(response, Chr(13), "") 'Remove line breaks
    response = Trim(response)
    
    gethttpseid = response
End Function
Editor is loading...