WinHTTP run-time error

[Ashe]

I'm not 100% sure how to describe this error as I'm not familiar with WinHTTP, so please bear with me!

This Excel file runs on my computer, but it runs for no one else. My coworkers have the same system, same version of Excel, macros are enabled, the properties in VBA are all the same, and this file has supposedly been "broken" for months, before I came to this department. My coworker gave it to me on a whim to see if I could fix it. I ran the document to see what it does and it worked perfectly fine, which has left everyone stumped. Based on my observations, everyone is getting the same error result, shown below:

I was also told that the person who coded this document wasn't the best at it, but as I'm learning as I go, I have no idea if anything is redundant or erroneous in this code.

Here's the raw code from the image:

Function userInfo(h As Object, username$) As String
'Used to pull information about a user such as badge # and employee ID
    h.SetAutoLogonPolicy 0
    h.SetTimeouts 0, 0, 0, 0
    h.Open "GET", "website" & username$
    h.send
    h.waitforresponse
    userInfo = h.responseText
End Function

If need be I can provide more of the code! That's just the piece that the Debug flags.
Thank you in advance for your help!

 

[jkpieterse]

Yes we'd need more of the code, especially the bit that calls this routine would be useful.

 

[Ashe]

Yes we'd need more of the code, especially the bit that calls this routine would be useful.

Of course! Here's the entirety of it:

Sub Pokedex()
Dim badge$, userID$, personInfo$
Dim table As New HTMLDocument, c As New DataObject
Dim h As Object

Set h = CreateObject("WinHTTP.WinHTTPRequest.5.1")
h.SetAutoLogonPolicy 0

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

badge = Split(Split(userInfo(h, Environ("Username")), "badgeBarcodeId"":""", , vbBinaryCompare)(1), """", , vbBinaryCompare)(0) 'calls function userInfo to get badge # of user
'userID = Split(Split(userInfo(h, Environ("Username")), "employeeId"":""", , vbBinaryCompare)(1), """", , vbBinaryCompare)(0)     'calls function userInfo to get user's ID #

'log user in to menu using badge number
body = "badgeBarcodeId=" & badge
    h.Open "POST", "Menu Link"
    h.setRequestHeader "Referer", "Login Link"
    h.setRequestHeader "Host", "Host Link"
    h.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    h.send body
    h.waitforresponse
   
limit = Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A"))
For I = 2 To limit
    On Error Resume Next
   
    personInfo = Split(Split(userInfo(h, Sheets("Sheet1").Range("A" & I)), "employeeId"":""", , vbBinaryCompare)(1), """", , vbBinaryCompare)(0)
   
    h.Open "GET", "Time Details Link" & personInfo & "&warehouseId=Mywarehouse"
    h.setRequestHeader "Referer", "Welcome Link"
    h.setRequestHeader "Host", "Portal Link"
    h.send
   
    table.body.innerHTML = h.responseText
    c.SetText table.getElementsByTagName("table")(3).outerHTML
    c.PutInClipboard
    Sheets("Hidden").Cells.ClearContents
    Sheets("Hidden").Activate
    Sheets("Hidden").Range("A1").Select
    ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
   
   
    last = Application.WorksheetFunction.CountA(Sheets("Hidden").Range("A:A"))
    If Sheets("Hidden").Range("A" & last) <> "m" And Sheets("Hidden").Range("A" & last) <> "i" Then
        Sheets("Sheet1").Range("B" & I) = Sheets("Hidden").Range("A" & last)
    Else
        Sheets("Sheet1").Range("B" & I) = Sheets("Hidden").Range("B" & last)
    End If
Next I

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

    Sheets("Sheet1").Activate
    Sheets("Sheet1").Range("A1").Select
End Sub

Function userInfo(h As Object, username$) As String
'Used to pull information about a user such as badge # and employee ID
    h.SetAutoLogonPolicy 0
    h.SetTimeouts 0, 0, 0, 0
    h.Open "GET", "ajax Link" & username$
    h.send
    h.waitforresponse
    userInfo = h.responseText
End Function

Sub reset()
Sheets("Sheet1").Range("A2:B10000").ClearContents

Sheets("Sheet1").Range("A10000").Copy
Sheets("Sheet1").Range("A2:A10000").PasteSpecial Paste:=xlPasteFormats

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select
End Sub

 

[jkpieterse]

Hmm. I strongly suspect it will not be possible to test this outside of your company network, think it requires a specific setup.

 

[Ashe]

Hmm. I strongly suspect it will not be possible to test this outside of your company network, think it requires a specific setup.

Aw, dang... I was afraid of that. I haven't the foggiest clue as to why it works for me and no one else

 

[jkpieterse]

Why is the userInfo function different in these two posts?
I get a different error message:
"The URL does not use a recognized protocol"

 

[Ashe]

I removed the links that are supposed to go in them as they lead to information that is otherwise not supposed to go outside of the company. Whether it says "website" or "ajax", the link would still be the same when plugged back in

 

[jkpieterse]

Right. It is often the case that questions about reaching out to web sources are hard to answer due to absence of those resources to us, the people trying to help. :-/