22. Oktober 2015 13:55
Function replaceEntityDetailHTML(quotedetailid As String, ATT As String, placeholder As String)
Dim xml As Variant
xml = ""
xml = xml + "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>"
xml = xml + "<soap:Envelope xmlns:soap=" & Chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & Chr(34) & " xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & " xmlns:xsd=" & Chr(34) & "http://www.w3.org/2001/XMLSchema" & Chr(34) & ">"
xml = xml + " <soap:Header>"
xml = xml + " <CrmAuthenticationToken xmlns=" & Chr(34) & "http://schemas.microsoft.com/crm/2007/WebServices" & Chr(34) & ">"
xml = xml + " <AuthenticationType xmlns=" & Chr(34) & "http://schemas.microsoft.com/crm/2007/CoreTypes" & Chr(34) & ">0</AuthenticationType>"
xml = xml + " <OrganizationName xmlns=" & Chr(34) & "http://schemas.microsoft.com/crm/2007/CoreTypes" & Chr(34) & ">" + org + "</OrganizationName>"
xml = xml + " <CallerId xmlns=" & Chr(34) & "http://schemas.microsoft.com/crm/2007/CoreTypes" & Chr(34) & ">00000000-0000-0000-0000-000000000000</CallerId>"
xml = xml + " </CrmAuthenticationToken>"
xml = xml + " </soap:Header>"
xml = xml + "<soap:Body>"
xml = xml + "<Fetch xmlns='http://schemas.microsoft.com/crm/2007/WebServices'>"
xml = xml + "<fetchXml>"
xml = xml + "<fetch mapping='logical'>"
xml = xml + "<entity name='quotedetail'>"
xml = xml + "<attribute name='" + ATT + "' />"
xml = xml + "<filter type='and'>"
xml = xml + "<condition attribute='quotedetailid' operator='eq' value='" + quotedetailid + "' />"
xml = xml + "</filter>"
xml = xml + "</entity>"
xml = xml + "</fetch>"
xml = xml + "</fetchXml>"
xml = xml + "</Fetch>"
xml = xml + "</soap:Body>"
xml = xml + "</soap:Envelope>"
xml = xml + ""
'MsgBox (xml)
Dim httprequest As Object
Set httprequest = CreateObject("Msxml2.XMLHTTP")
httprequest.Open "post", service, False, "", ""
httprequest.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/crm/2007/WebServices/Fetch"
httprequest.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
httprequest.setRequestHeader "Content-Length", Len(xml)
httprequest.sEnd (xml)
Dim result As Object
Set result = httprequest.responseXML
'MsgBox (result.xml)
Dim resultSet As String
resultSet = result.Text
resultSet = Replace(resultSet, "<", "<")
resultSet = Replace(resultSet, ">", ">")
Dim gtpos As Variant
gtpos = InStr(1, resultSet, "<result>", vbTextCompare) - 1
resultSet = "<resultset>" + Right(resultSet, Len(resultSet) - gtpos)
resultSet = Replace(resultSet, "<resultset>", "")
resultSet = Replace(resultSet, "</resultset>", "")
resultSet = Replace(resultSet, "<result>", "")
resultSet = Replace(resultSet, "<result>", "")
resultSet = Replace(resultSet, "<" + ATT + ">", "")
resultSet = Replace(resultSet, "</" + ATT + ">", "")
'MsgBox (resultSet)
resultSet = Replace(resultSet, " ", Chr(13))
gtpos = InStr(1, resultSet, "<quotedetailid>", vbTextCompare) - 1
resultSet = Left(resultSet, gtpos)
End Function