Dim s As String
Dim listName As String
Dim viewName As String
Dim strSoapAction As String
'Private oSoapClient As SoapClient30
Sub Button1_Click()
Call PublishList
End Sub
Option Explicit
Public Sub PublishList()
' WebService URL
Dim serviceUrl As String
serviceUrl = "http://einstein/sites/Vendors/_vti_bin/Lists.asmx"
'serviceUrl = "http://zew-v-0ac2806f.vpc2-eu.aws.shell-cloud.com:84/sites/vendors/_vti_bin/Lists.asmx"
'list guid for list name (SERP Create on Dev Seat http://zew-v-0ac2806f.vpc2-eu.aws.shell-cloud.com:84/sites/vendors)
listName = "{1B3DFFF3-E3E4-435C-A1FA-C99181770F40}"
'viewName = "{47B9A34B-38E7-44E2-B04D-08B38CAF1832}"
s = "<Batch OnError='Continue' ListVersion='1' ViewName='" & viewName & "'>" & _
"<Method ID='1' Cmd='New'>" & _
"<Field Name='ID'>New</Field>" & _
"<Field Name='Title'>Hello Indicator</Field>" & _
"</Method>" & _
"</Batch>"
' Creating Soap Envelop
Dim soapEnv As String
soapEnv = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
"<soapenv:Body>" & _
"<UpdateListItems xmlns=""http://schemas.microsoft.com/sharepoint/soap/"">" & _
"<listName>" & listName & "</listName>" & _
"<updates>" & _
"<Batch OnError='Continue' ListVersion='1' ViewName='" & viewName & "'>" & _
"<Method ID='1' Cmd='New'>" & _
"<Field Name='ID'>New</Field>" & _
"<Field Name='Title'>Hello Ashok</Field>" & _
"</Method>" & _
"</Batch>" & _
"</updates>" & _
"</UpdateListItems>" & _
"</soapenv:Body>" & _
"</soapenv:Envelope>"
strSoapAction = "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
MsgBox soapEnv
Call PostWebservice(serviceUrl, strSoapAction, soapEnv)
End Sub
Private Function PostWebservice(ByVal AsmxUrl As String, ByVal SoapActionUrl As String, ByVal XmlBody As String) As String
Dim objDom As Object
Dim objXmlHttp As Object
Dim strRet As String
Dim intPos1 As Integer
Dim intPos2 As Integer
On Error GoTo Err_PW
MsgBox XmlBody
' Create objects to DOMDocument and XMLHTTP
Set objDom = CreateObject("MSXML2.DOMDocument")
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")
' Load XML
objDom.async = False
objDom.LoadXML XmlBody
' Open the webservice
objXmlHttp.Open "POST", AsmxUrl, False
' Create headings
objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objXmlHttp.setRequestHeader "SOAPAction", SoapActionUrl
' Send XML command
objXmlHttp.send objDom.XML
' Get all response text from webservice
strRet = objXmlHttp.responseText
MsgBox strRet
' Close object
Set objXmlHttp = Nothing
' Extract result
intPos1 = InStr(strRet, "Result>") + 7
intPos2 = InStr(strRet, "</")
If intPos1 > 7 And intPos2 > 0 Then
strRet = Mid(strRet, intPos1, intPos2 - intPos1)
End If
' Return result
PostWebservice = strRet
Exit Function
Err_PW:
PostWebservice = "Error: " & Err.Number & " - " & Err.Description
End Function
Dim listName As String
Dim viewName As String
Dim strSoapAction As String
'Private oSoapClient As SoapClient30
Sub Button1_Click()
Call PublishList
End Sub
Option Explicit
Public Sub PublishList()
' WebService URL
Dim serviceUrl As String
serviceUrl = "http://einstein/sites/Vendors/_vti_bin/Lists.asmx"
'serviceUrl = "http://zew-v-0ac2806f.vpc2-eu.aws.shell-cloud.com:84/sites/vendors/_vti_bin/Lists.asmx"
'list guid for list name (SERP Create on Dev Seat http://zew-v-0ac2806f.vpc2-eu.aws.shell-cloud.com:84/sites/vendors)
listName = "{1B3DFFF3-E3E4-435C-A1FA-C99181770F40}"
'viewName = "{47B9A34B-38E7-44E2-B04D-08B38CAF1832}"
s = "<Batch OnError='Continue' ListVersion='1' ViewName='" & viewName & "'>" & _
"<Method ID='1' Cmd='New'>" & _
"<Field Name='ID'>New</Field>" & _
"<Field Name='Title'>Hello Indicator</Field>" & _
"</Method>" & _
"</Batch>"
' Creating Soap Envelop
Dim soapEnv As String
soapEnv = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
"<soapenv:Body>" & _
"<UpdateListItems xmlns=""http://schemas.microsoft.com/sharepoint/soap/"">" & _
"<listName>" & listName & "</listName>" & _
"<updates>" & _
"<Batch OnError='Continue' ListVersion='1' ViewName='" & viewName & "'>" & _
"<Method ID='1' Cmd='New'>" & _
"<Field Name='ID'>New</Field>" & _
"<Field Name='Title'>Hello Ashok</Field>" & _
"</Method>" & _
"</Batch>" & _
"</updates>" & _
"</UpdateListItems>" & _
"</soapenv:Body>" & _
"</soapenv:Envelope>"
strSoapAction = "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
MsgBox soapEnv
Call PostWebservice(serviceUrl, strSoapAction, soapEnv)
End Sub
Private Function PostWebservice(ByVal AsmxUrl As String, ByVal SoapActionUrl As String, ByVal XmlBody As String) As String
Dim objDom As Object
Dim objXmlHttp As Object
Dim strRet As String
Dim intPos1 As Integer
Dim intPos2 As Integer
On Error GoTo Err_PW
MsgBox XmlBody
' Create objects to DOMDocument and XMLHTTP
Set objDom = CreateObject("MSXML2.DOMDocument")
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")
' Load XML
objDom.async = False
objDom.LoadXML XmlBody
' Open the webservice
objXmlHttp.Open "POST", AsmxUrl, False
' Create headings
objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objXmlHttp.setRequestHeader "SOAPAction", SoapActionUrl
' Send XML command
objXmlHttp.send objDom.XML
' Get all response text from webservice
strRet = objXmlHttp.responseText
MsgBox strRet
' Close object
Set objXmlHttp = Nothing
' Extract result
intPos1 = InStr(strRet, "Result>") + 7
intPos2 = InStr(strRet, "</")
If intPos1 > 7 And intPos2 > 0 Then
strRet = Mid(strRet, intPos1, intPos2 - intPos1)
End If
' Return result
PostWebservice = strRet
Exit Function
Err_PW:
PostWebservice = "Error: " & Err.Number & " - " & Err.Description
End Function
No comments:
Post a Comment