Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
WinHTTP (VBA Excel)
Option Explicit
Function GetDataFromURL()
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open "POST", "http://subdomain.authoritylabs.com/watched_domains/(watched_domain_id)/watched_keywords.xml"
objWinHttp.SetRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
objWinHttp.SetCredentials "APIKEY", "PASSWORD", 0
On Error Resume Next
objWinHttp.Send ("keyword_name=microsoft" + vbCrLf + "excel")
MsgBox objWinHttp.ResponseText
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
GetDataFromURL = objWinHttp.ResponseText
Else
GetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
End Function
@kibaekr
Copy link

kibaekr commented Jun 7, 2012

oolala

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment