Upload files to SharePoint using Excel

This is a minor task I undertook quite a while ago, I think someone might want to do something similar and hence decided to share the vba code, note that some of the code was sourced form somewhere else unfortunately I can't find the original source any more.


Public Sub CallWebService()
 'Set and instantiate our working objects

 Dim fileName As String
 Dim fileName2 As String
 Dim base64_data As String
 fileName = Application.GetOpenFilename("Comma Separated Values (*.pdf),*.pdf")

    If fileName <> "False" Then
        'Workbooks.Open fileName, Format:=2
         'Sheets1.Range("A2").Value = EncodeFile(fileName)
         fileName2 = Dir(fileName, vbDirectory)
         'MsgBox fileName2
         base64_data = EncodeFile(fileName)
    Else
       Return
    End If

    Dim Req As Object
    Dim sEnv As String
    Dim Resp As New MSXML2.DOMDocument60  '60
    Set Req = CreateObject("MSXML2.XMLHTTP")
    Set Resp = CreateObject("MSXML2.DOMDocument.6.0")
    Req.Open "Post", "https://home.contoso.com/_vti_bin/copy.asmx", False
    ' need to get the filename part
 
    ' we create our SOAP envelope for submission to the Web Service
 
    sEnv = ""
    sEnv = sEnv + ""
    sEnv = sEnv + ""
    sEnv = sEnv + "" + fileName + ""
    sEnv = sEnv + " "
    sEnv = sEnv + "https://home.contoso.com/sites/ITCDev/InvoiceDemo/" + fileName2 + ""
    sEnv = sEnv + "
"    sEnv = sEnv + ""
    sEnv = sEnv + ""
    sEnv = sEnv + ""
    sEnv = sEnv + " "
    sEnv = sEnv + " "
    sEnv = sEnv + " "
    sEnv = sEnv + "  "
    sEnv = sEnv + "  "
    sEnv = sEnv + "  
"    sEnv = sEnv + "   " + base64_data + ""
    sEnv = sEnv + "
"    sEnv = sEnv + "
"    sEnv = sEnv + "
"             
     'sEnv = sEnv & ";"
     'sEnv = sEnv & "  "
     'sEnv = sEnv & "  "
     'sEnv = sEnv & "   "
     'sEnv = sEnv & "    username"
     'sEnv = sEnv & "    password"
     ''Looks for SKU in active worksheet cell B3
     'sEnv = sEnv & "    " & Range("B3").Value & ""
     'sEnv = sEnv & "  
"     'sEnv = sEnv & "
"     'sEnv = sEnv & "
"    ' Send SOAP Request
 
    Req.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
    Req.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/CopyIntoItems"
    Req.send (sEnv)

    'oXMLHttp.open("POST", strSoapURL, false, "SVC_E4SE", "Ep1c@rIC#1.2");
    'oXMLHttp.setRequestHeader("Content-Type", "text/xml; charset=utf-8");
    'oXMLHttp.setRequestHeader("SOAPAction", "http://epicor.com/webservices/" + actionName);
    'oXMLHttp.send(oReqXML.xml);


' Display results in MessageBox
    'MsgBox Req.responseText
    Resp.LoadXML Req.responseText
    Range("B6").Value = Resp.XML
 
  'clean up code
    Set Req = Nothing
    Set Resp = Nothing
 
 
End Sub


Public Function EncodeFile(strPicPath As String) As String
    Const adTypeBinary = 1          ' Binary file is encoded

    ' Variables for encoding
    Dim objXML
    Dim objDocElem

    ' Variable for reading binary picture
    Dim objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (strPicPath)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"

    ' Set binary value
    objDocElem.nodeTypedValue = objStream.Read()

    ' Get base64 value
    EncodeFile = objDocElem.Text

    ' Clean all
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing

End Function