LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 473
Default Sending data as POST request to a Webserver via VBA

Uwe Herrmann wrote:
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("Quer y_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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Test post at request of admin CellMan[_2_] Excel Discussion (Misc queries) 0 March 3rd 09 07:56 PM
Meeting Request Outlook XP sending to some Ailish Excel Discussion (Misc queries) 1 May 9th 08 01:08 PM
ERROR sending the post CLR New Users to Excel 7 October 12th 06 06:44 PM
Should I generally request "post a poll" when I post a new thread? Joe Miller Excel Discussion (Misc queries) 2 January 7th 06 04:46 PM
Copy file from drive to webserver Anders[_3_] Excel Programming 0 September 18th 03 08:53 AM


All times are GMT +1. The time now is 03:45 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"