Uwe said:
Could you send me example code to use the msinet.ocx under Excel?
I would prefer example code for making a POST Request!
Here goes.
It is cut straight out of a bigger project and will need some editing
to work. My example posts some XML and gets XML back.
With thanks to Stephen Bullen who gave me the code originally, if I
recall correctly.
---
Dim C As clsInet
Function PostXML(stXML As String, Optional ByVal TestOnly As Boolean =
False) As String
' post the XML (to be made URL-safe) and return the XML we get back
On Error GoTo locErr
Dim stURL As String
Dim stResp As String
stURL =
ActiveWorkbook.Worksheets(cstDefSheet).Range("Query_URL").Value
If stURL = "" Then
PostXML = "!No URL has been set up; please Set Access Parameters"
Else
Set C = New clsInet
Set C.oINet = New Inet
C.oINet.AccessType = icDirect
stResp = INetPost(stURL, stXML)
'Debug.Print stResp
If stResp = "" Then stResp = "!No response received from server"
PostXML = stResp
End If
TidyUp:
If Not C Is Nothing Then
If Not C.oINet Is Nothing Then
If C.oINet.StillExecuting Then C.oINet.Cancel
Set C.oINet = Nothing
End If
End If
Set C = Nothing
Exit Function
locErr:
stResp = "!Error " & Err.Number & ": " & Err.Description
If ReportError(Err.Description, Err.Number, "modCalls", "PostXML") =
vbRetry Then
Resume
Else
PostXML = stResp
Resume TidyUp
End If
End Function
Function INetPost(stURL As String, stXML As String) As String
Dim stPost As String
Dim stErr As String
Dim stHeader As String
Dim stResult As String
Dim stBit As String
Dim iCanc As Integer
On Error GoTo locErr
' convert the XML to URL-encoding
iCanc = Application.EnableCancelKey
stPost = "xml=" & URLSafe(stXML)
Application.EnableCancelKey = xlErrorHandler
' indicate URL-encoded data as from a form
stHeader = "Content-Type: application/x-www-form-urlencoded"
' probably unnecessary and it didn't help when StillExecuting was set
If C.oINet.StillExecuting Then C.oINet.Cancel
' 2 minutes is long enough to wait
C.oINet.RequestTimeout = 120
' post the information to the nominated URL
C.oINet.Execute stURL, "GET", stPost, stHeader
' loop while it churns away, giving it a go.
Do While C.oINet.StillExecuting
DoEvents
Loop
' if there was an error it will be reported here as State=11
If C.iState = 11 Then
stErr = "Internet problem: " & C.Message
Else
stResult = ""
'Debug.Print "State", C.iState
Do
' seems to be broken up into chunks which need adding together
stBit = C.oINet.GetChunk(32000)
'Debug.Print "Got 1", Len(stBit), Right(stBit, 20)
stResult = stResult & stBit
Loop While Len(stBit) > 0
'Debug.Print "Got 2", Len(stResult), Right(stResult, 20)
End If
INetPost = stResult
TidyUp:
Application.EnableCancelKey = iCanc
Exit Function
locErr:
If Err.Number = 18 Then
' cancelled
MyMsgBox "Cancelled"
INetPost = "!Cancelled"
Resume TidyUp
ElseIf Err.Number >= 35750 And Err.Number <= 36000 Then
stErr = C.ErrDesc(Err.Number)
If stErr = "" Then stErr = Err.Description
stErr = "Error " & Err.Number & ": " & stErr
MyMsgBox "Sorry - failed to communicate with the server" &
vbNewLine & _
stErr, vbExclamation
INetPost = "!INet " & stErr
Resume TidyUp
End If
INetPost = "!INet error " & Err.Number & ": " & stErr
If ReportError(stErr, Err.Number, "modDoUpload", "INetPost") =
vbRetry Then
Resume
Else
Resume TidyUp
End If
End Function
Function URLSafe(ST As String) As String
' convert characters in ST to %nn as necessary for URL encoding
Dim iChar As Long
Dim CH As String
On Error GoTo locErr
For iChar = 1 To Len(ST)
CH = Mid(ST, iChar, 1)
Select Case CH
Case "!", "#", "$", "%", "&", "(", ")", "/", ":", ";", "[", "\",
"]", _
"^", "'", "{", "|", "}", "+", "<", "=", ">", vbCr, "`", "?"
URLSafe = URLSafe & "%" & IIf(Asc(CH) < 16, "0", "") &
Hex(Asc(CH))
Case vbLf
' strip
Case " "
URLSafe = URLSafe & "+"
Case Else
URLSafe = URLSafe & CH
End Select
Next
TidyUp:
Exit Function
locErr:
If ReportError(Err.Description, Err.Number, "modFunctions",
"URLSafe") = vbRetry Then
Resume
Else
Resume TidyUp
End If
End Function
Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup
