login.vba

Private Sub login()
    Dim sfc As SfdcSoapXml
    Set sfc = New SfdcSoapXml
     
    Dim body As String
    body = sfc.LOGIN
    body = Replace(body, "{{username}}", "*******")
    body = Replace(body, "{{password}}", "******")
    Dim response As String
    response = callSoap("https://login.salesforce.com/services/Soap/u/30.0", body)
     
    Dim oXml As DOMDocument
    Set oXml = createObject("MSXML.DOMDocument")
    oXml.LoadXML (response)
     
    Dim serverUrl As String
    serverUrl = oXml.getElementsByTagName("serverUrl").Item(0).Text
     
    Dim sessionId As String
    sessionId = oXml.getElementsByTagName("sessionId").Item(0).Text
    Dim orgId As String
    orgId = oXml.getElementsByTagName("organizationId").Item(0).Text
 
    'https://*.salesforce.com/services/Soap/u/のドメイン名まで取得
    Dim re As RegExp
    Dim mc As MatchCollection
    Set re = New RegExp
    re.Pattern = "^(https://[a-zA-Z0-9-\.]*)/"
    Set mc = re.Execute(serverUrl)
    Dim m As Match
     
    Dim instanceUrl As String
    instanceUrl = mc.Item(0).SubMatches.Item(0)
End Sub
 
Private Function callSoap(ByVal endpoint As String, ByVal body As String) As String
    Dim objXmlHttp As Object
    Set objXmlHttp = createObject("MSXML2.XMLHTTP")
     
    objXmlHttp.Open "POST", endpoint, False
    Call objXmlHttp.setRequestHeader("Content-Type", "text/xml;charset=UTF-8")
    Call objXmlHttp.setRequestHeader("SOAPAction", """""")
     
    objXmlHttp.send (body)
     
    callSoap = objXmlHttp.responseText
End Function