SOAP Webservice authentifié par VBA (Excel)

Version imprimable

26/02/2016, 18h37
ElBartoon

1 pièce(s) jointe(s)

SOAP Webservice authentifié par VBA (Excel)

Bonjour,

J'ai lu cette discussion.
Je cherche à faire ce qui semblerait exactement la même chose, communiquer avec un WebService nécessitant une authentification SOAP avec du VBA Excel.

Après une pléiade de recherches infructueuses (avant que quelqu'un me dise Google est ton ami), je vacilles entre les lectures qui me disent que ce n'est pas possible et d'autre si, je suis perdu.
J'ai a peu près démêler qu'il me fallait des connaissances en XML pour le SOAP, mais je suis incapable d'aller plus loin. J'ai essayé de copier le SOAP que j'ai obtenu en utilisant un snifer de paquets, mais j'ai l'impression qu'il a des champs que je dois généré de façon dynmaique, comme la date par exemple.
Pièce jointe 202091

J'ai aussi suivi le tuto complet mais en particulier Requêtes HTTP (MSXML2 ou WinHTTP), mais là je cale

Donc Help and UP !

Bonjour,

tu avais trouvé dans tes recherches ça ? http://www.developpez.net/forums/d47...rvices-access/

si ça ne répond pas du tout à ton besoin .... je te montre très timidement un exemple de ma part, qui est lié aux webservices de sites SharePoint.
je m'y suis mis très très très récemment, et je n'ai aucune idée de la transposabilité ou non de ce type de procédure sur d'autres structures que SharePoint. Pour apprendre à utiliser ces webservices, j'ai simplement consulté les propriétés et méthodes du webservice accessibles directement sur le site SharePoint ... et perdu une bonne partie de mes cheveux :aie:

Ps : attention, c'est juste pour montrer la structure d'un de mes codes (j'en ai réalisé une bonne 50aines pour brasser un large panel de fonctionnalités). Si ça peut te servir j'en suis ravi. Dans le cas contraire : ne tient pas compte de mon message :aie:

Une fonction qui récupère des éléments (ici, tous les groupes d'utilisateurs d'un site SharePoint) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Function GetLesGroupes(webUrl As String)
 Dim soapClient As MSXML2.XMLHTTP: Set soapClient = New MSXML2.XMLHTTP
 Dim xmlDoc As MSXML2.DOMDocument: Set xmlDoc = New MSXML2.DOMDocument
 Dim body As String
 
 body = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
        "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
        "<soap:Body>" & _
        "<GetGroupCollectionFromSite xmlns=""http://schemas.microsoft.com/sharepoint/soap/directory/"" />" & _
        "</soap:Body>" & _
        "</soap:Envelope>"
 
 
 xmlDoc.LoadXML body
 soapClient.Open "POST", webUrl & "_vti_bin//usergroup.asmx", False
 soapClient.send xmlDoc
 
 Dim strGroups As String
 strGroups = ""
 If soapClient.readyState = 4 Then
    If soapClient.Status = 200 Then
        Dim grp As IXMLDOMNode
        For Each grp In soapClient.responseXML.getElementsByTagName("Group")
            Debug.Print (grp.XML)
            Dim attr As IXMLDOMAttribute
 
            For Each attr In grp.Attributes
                If attr.Name = "Name" Then
                    If strGroups <> "" Then
                        strGroups = strGroups & ";"
                    End If
                    strGroups = strGroups & attr.Value
                    Exit For
                End If
            Next
        Next
    Else
 
    End If
 End If
 
GetLesGroupes = strGroups
End Function

ici, un code qui injecte des éléments (ajout d'utilisateurs dans un groupe SharePoint)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub AddUserToGroup(webUrl As String, grp As String, ByVal Lelogin As String, ByVal NomDuSharepoint As String)
Dim soapClient As MSXML2.XMLHTTP: Set soapClient = New MSXML2.XMLHTTP
Dim xmlDoc As MSXML2.DOMDocument: Set xmlDoc = New MSXML2.DOMDocument
 
Dim body As String
 
body = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
        "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
            "<soap:Body>" & _
                "<AddUserToGroup xmlns=""http://schemas.microsoft.com/sharepoint/soap/directory/"">" & _
                    "<groupName>" & grp & "</groupName>" & _
                    "<userLoginName>" & Lelogin & "</userLoginName>" & _
                "</AddUserToGroup>" & _
            "</soap:Body>" & _
        "</soap:Envelope>"
xmlDoc.LoadXML body
 
 
soapClient.Open "POST", webUrl & "_vti_bin//usergroup.asmx", False
soapClient.setRequestHeader "Host", NomDuSharepoint
soapClient.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
soapClient.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/directory/AddUserToGroup"
soapClient.send xmlDoc
 
'If soapClient.readyState = 4 Then
    'MsgBox soapClient.statusText & " " & soapClient.Status
    If soapClient.Status <> 200 Then
        Debug.Print "Erreur : " & Lelogin & " dans " & grp
    End If
'End If
 
End Sub

29/02/2016, 18h30
ElBartoon

Bonjour Joe, et merci pour la réponse,

C'est ce que je suis en train de me rendre compte il y a peu de ressources concernant le sujet. Sujet que je me suis permis de préciser (je pensais faire un up du précédent sujet, mais il s'avère que non).

J'ai regardé ton lien, c'est sur de l'Access, je ne suis pas familier avec le VBA pour Access, il me semble qu'il y a des différences notables tout de même avec celui pour Excel, mais j’élargis mes perspectives au fur et à mesure de mes recherches.

Je suis en train de voir ce que je peux faire avec ce que tu me donnes, mais en fait ma plus grande problématique et de faire passer l'authentification SOAP pour que le Webservice me donne les infos.
J'ai d'ailleurs trouvé d'autres threads developpez qui n'aboutissent pas, exemple VBA : Service Web avec SOAP et HTTPS
J'ai aussi trouvé de quoi creuser, ça parle de SharePoint, comme toi, https://msdn.microsoft.com/en-us/lib...code-snippet-1

1 pièce(s) jointe(s)

Bonjour le forum,

J'y suis arrivé, après deux ou trois semaines d’acharnement ça fonctionne je suis capable d'interroger l'API avec mon code VBA, :yaisse2: Youhou !!:yaisse2:
Je dois confesser que je ne connaissais pas le système de Webservice et API, que de nom, j'avais de vague notion d'XML, j’ignorais l’existence de SOAP et que je pensais avoir fait le tour du VBA (sans prétentions), à part quelques subtilités. Ça me fait penser que j'ose imaginer le nombre de librairies disponibles pour Excel pour lui faire faire n'importe quoi.
Je précise ça parce que je pense qu'il faut savoir de quoi il retourne pour comprendre un peu de quoi on parle. Pour que ça fonctionne avec une autre API, il va falloir lire l'XML, le SOAP, un modèle de préférence, sinon comme moi j'ai travaillé avec un snifer pour calquer les champs importants à mettre dans enveloppe SOAP.
Trêves d'intro, le vif du sujet...

Pour résumer, il a fallu créer un fichier SOAP au format XML dans le code VBA, en fait en texte "brut" pour l'envoyer via une requête HTTP toujours en VBA. Et traiter la réponse, cette partie là est encore embryonnaire.

Pré-requis, les librairies :
Je ne suis exactement sûr desquelles sont essentielles, je les ai activées lors du tuto VBA et développement Web (il y aura plus de détail sur le lien), mais il fait maximalement celles ci pour fonctionner. J'ai surligné en jaune celles que je pense être obligatoires.
Pièce jointe 202778
Petit point à la co*, avec la période d’apprivoisement avec les notions précédentes (XML, API, etc), je pense avoir buté sur une chose simple, avoir la bonne adresse pour communiquer avec l'API, j'avais un truc du format https://*ADDRESSE API*/Api/v2/Downloads/***.wsdl au lieu de https://*ADDRESSE API*/Api/v2/***.asmx, je n'ai pas suffisament de connaissance pour savoir ce qu'est une bonne adresse et une mauvaise mais vérifier ce point me semble une bonne chose pour partir sur de bons rails.
Le code:
Le code est dégeu, mais il fonctionne, je n'ai encore la mesure de ce qui est utilisé ou pas, mais dans les faits il reste plus qu'à le formater, et le rendre fonctionnel avec une fonction d'envois de données. Pour le moment on ne fait que consulter.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 Sub API_CALL() Dim sURL As String Dim sEnv As String Dim xmlDoc As New DOMDocument Dim sEnvlength As Integer Dim responseText As String Dim MyString As String Dim LastRow As Long MyString = "GetClaimStatus" Set ObjHttp = New MSXML2.XMLHttp sURL = "http://*ADDRESSE API*/Api/v2/***.asmx" sEnv = sEnv & "<?xml version=""1.0"" encoding=""utf-8""?>" sEnv = sEnv & "<soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:wsa=""http://schemas.xmlsoap.org/ws/2004/08/addressing"" xmlns:wsse=""http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"" xmlns:wsu=""http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd"">" sEnv = sEnv & " <soap:Header>" sEnv = sEnv & " <AuthenticationHeader AccountNumber=""USERNAME"" Password=""PASSWORD"" xmlns=""http://*ADDRESSE API*/webservices/"" />" sEnv = sEnv & " <wsa:Action>http://*ADDRESSE API*/webservices/GetClaimStatus</wsa:Action>" sEnv = sEnv & " <wsa:MessageID>urn:uuid:5e261edc-603f-46dc-8d62-a39ad3986f26</wsa:MessageID>" sEnv = sEnv & " <wsa:ReplyTo>" sEnv = sEnv & " <wsa:Address>http://schemas.xmlsoap.org/ws/2004/08/addressing/role/anonymous</wsa:Address>" sEnv = sEnv & " </wsa:ReplyTo>" sEnv = sEnv & " <wsa:To>http://*ADDRESSE API*/Api/v2/***.asmx</wsa:To>" sEnv = sEnv & " <wsse:Security>" sEnv = sEnv & " <wsu:Timestamp wsu:Id=""Timestamp"">" sEnv = sEnv & " <wsu:Created>" & Format(Now(), "yyyy-MM-dd") & "T" & Format(Now() + TimeSerial(5, 0, 0), "hh:mm:ss") & "Z</wsu:Created>" '+ TimeSerial(5, 0, 0) means + 5 hours, because Test is + 5 hours with Montreal sEnv = sEnv & " <wsu:Expires>" & Format(Now(), "yyyy-MM-dd") & "T" & Format(Now() + TimeSerial(5, 0, 0) + TimeSerial(0, 5, 0), "hh:mm:ss") & "Z</wsu:Expires>" sEnv = sEnv & " </wsu:Timestamp>" sEnv = sEnv & " </wsse:Security>" sEnv = sEnv & " </soap:Header>" sEnv = sEnv & " <soap:Body>" sEnv = sEnv & " <GetClaimStatus xmlns=""http://*ADDRESSE API*/webservices/"">" sEnv = sEnv & " <claimIDSpecification ClaimID=""22_02_2016_01"" ClaimIDType=""ClaimNumber"" />" sEnv = sEnv & " <companyIDSpecification CompanyID=""049-246-601"" CompanyIDType=""CompanyID"" />" sEnv = sEnv & " </GetClaimStatus>" sEnv = sEnv & " </soap:Body>" sEnv = sEnv & "</soap:Envelope>" sEnvlength = Len(sEnv) ObjHttp.Open "POST", sURL, False ObjHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8" ObjHttp.setRequestHeader "Content-Length", sEnvlength ObjHttp.send (sEnv) xmlDoc.LoadXML (ObjHttp.responseText) Cells(1, 1) = ObjHttp.responseText responseText = xmlDoc.SelectNodes("//claimStatus")(0).Text 'on next i (=2) I got Error '91' - object variable or With block variable not set MsgBox responseText sEnv = "" Set xmlDoc = Nothing Set ObjHttp = Nothing End Sub
Dernier point, il y a des balises importantes sur lesquelles j'ai au début pensé qu'elles était secondaires, "Timestamp" je me suis résolu à les faire dynamiques, pour qu'elles prennent l'exacte heure du moment, le TimeSerial(5, 0, 0), c'est parce que j'ai un décalage de 5 heures avec le serveur, le TimeSerial(0, 5, 0) c'est pour ajouter 5 minutes à la date et heure actuelle pour calculer l'expiration. Par contre, <wsu:Timestamp wsu:Id=""Timestamp"">" à l'air bidon, je ne le change jamais il ça n'a pas l'air de poser problème. Idem pour <wsa:MessageID>urn:uuid:5e261edc-603f-46dc-8d62-a39ad3986f26</wsa:MessageID>". J'aurais cru qu'il aurait fallu les rendre unique mais apparemment non.

Citation:

Envoyé par joe.levrai

...
Ps : attention, c'est juste pour montrer la structure d'un de mes codes (j'en ai réalisé une bonne 50aines pour brasser un large panel de fonctionnalités). Si ça peut te servir j'en suis ravi. Dans le cas contraire : ne tient pas compte de mon message :aie:

...
End Sub[/code]

Merci Joe, pour ces codes ça m'a bien servi.

Comme c'est sur SHAREPOINT ONLINE (OFFICE 365 ), j'étais un peu en galère pour l'authentification, j'ai solutionné cela en cochant lors de l'authentification "rester en ligne" ou "rester connecté", si ça peut aider...

j'avais aussi un problème pour identifier le login de l'utilisateur qui commence en fait par i:0#.f|membership|

J'ai fait une fonction pour récupérer les membres d'un groupe, sur ton modèle.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Function GetUserCollectionFromGroup(webUrl As String, group As String)
    Dim soapClient As MSXML2.xmlhttp: Set soapClient = New MSXML2.xmlhttp
    Dim xmlDoc As MSXML2.DOMDocument: Set xmlDoc = New MSXML2.DOMDocument
    Dim body As String
 
    body = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
            "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
            "<soap:Body>" & _
            "<GetUserCollectionFromGroup xmlns=""http://schemas.microsoft.com/sharepoint/soap/directory/"">" & _
            "<groupName>" & group & "</groupName></GetUserCollectionFromGroup>" & _
            "</soap:Body>" & _
            "</soap:Envelope>"
 
 
    xmlDoc.LoadXML body
    soapClient.Open "POST", webUrl & "_vti_bin//usergroup.asmx", False
    soapClient.send xmlDoc
 
    Dim strGroups As String
    strGroups = ""
    If soapClient.readyState = 4 Then
        If soapClient.Status = 200 Then
            Dim grp As IXMLDOMNode
            Debug.Print soapClient.responseText
            For Each grp In soapClient.responseXML.getElementsByTagName("User")
 
 
                Debug.Print (grp.XML)
 
                Dim attr As IXMLDOMAttribute
 
                If strGroups <> "" Then
                    strGroups = strGroups & vbCr
                End If
                strGroups = strGroups & grp.Attributes.getNamedItem("Name").Text & ";" & grp.Attributes.getNamedItem("LoginName").Text
 
            Next
        Else
 
        End If
    End If
 
    GetUserCollectionFromGroup = strGroups
End Function

Ta cinquantaine de fonctions m’intéresse du coup fortement ;-)