Upload Excel File to SharePoint using VBA

Question

Hi,
I copied and modified the code from a friend which he got it from this website forum.
This apprantely works for some people and not me. Please tell me what I am doing wrong.
Ignore xxxxxx part of the Sharepoint site. Nothing wrong with the site, i tried many combinations, but I get not response, not even an error.
Public Const HR_URL = "http://sun.xxxxxx.com/eng/st/Lists/Database%20Change% 20Request"
Sub test()
'Upload new Excel sheet to SharePoint
Call copyToSharePoint(HR_URL, ThisWorkbook.FullName)
End Sub
'''''''code block from Forum
Public Sub copyToSharePoint(sharepointURL As String, filePath As String)
'On Error GoTo errhandler
'sharePointUrl should not end in a "/"
'Initialize Variables
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LvarBinData As Variant
Dim LstrFileName As String, PstrFullfileName As String, PstrTargetURL As String
Dim fileName As String, lenFileName As Long
'Extract file name
lenFileName = Len(filePath) - InStrRev(filePath, "\")
fileName = Right(filePath, lenFileName)
'Check that the webUrl ends in an "/"
If Right(sharepointURL, 1) <> "/" Then
sharepointURL = sharepointURL & "/"
End If
'**************************** Upload binary files *****************
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
PstrFullfileName = filePath
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointURL & fileName
' Put the data to the server; false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False
' Send the file in.
LobjXML.Send LvarBinData
Set LobjXML = Nothing
Exit Sub
errhandler:
If Err.Number = 53 Then
MsgBox "Excel was unable to create the HR file to submit to SharePoint. " & vbNewLine & _
"Please check that you are not running out of disk space and that no MS Office add-in is causing issues with Excel.", vbCritical, "File Error"
Exit Sub
Else
MsgBox "Your HR could not be submitted to SharePoint. The following error occurred:" & vbNewLine & _
"Error " & Err.Number & ": " & Err.Description, vbCritical, "Error Uploading to SharePoint"
Exit Sub
End If
End Sub

Answer 1

I have made the following code work successfully on a Windows 8 machine with the VBA executing from an Excel 2010 file and the file you want to upload going to a SharePoint 2010 site. If you don't need to use SP content types then simply
take that out of the code. Also, pay attention to the FieldInformation as the Field Display names and Field Internal names can sometimes be different. Cheers.
Public Sub copyDocToSP()
Const strLocalFile = "C:\temp\myLocalFile.pdf"
Const spBASE_URL = "https://thesharepointdomian/sites/yoursite/"
Const spDOC_LIB = "Your SP Doc Library Name"
Const spFILE_NAME = "FileNameOnceOnSharepoint.pdf"
Const spCONTENT_TYPE = "0x000000000000000000000000000000000000000"
Set ObjectStream = CreateObject("ADODB.Stream")
Set ObjectDOM = CreateObject("Microsoft.XMLDOM")
Set ObjectElement = ObjectDOM.createElement("TMP")
Set ObjectHTTP = CreateObject("Microsoft.XMLHTTP")
'Reading binary file
ObjectStream.Open
ObjectStream.Type = 1 'Type Binary
ObjectStream.LoadFromFile (strLocalFile)
BinaryFile = ObjectStream.Read()
ObjectStream.Close
'Conversion Base64
ObjectElement.DataType = "bin.base64" 'Type Base64
ObjectElement.nodeTypedValue = BinaryFile
EncodedFile = ObjectElement.Text
'Build request to load document
strURLService = spBASE_URL + "_vti_bin/copy.asmx"
strSOAPAction = "http://schemas.microsoft.com/sharepoint/soap/CopyIntoItems"
strSOAPCommand = "<?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>" & _
"<CopyIntoItems xmlns='http://schemas.microsoft.com/sharepoint/soap/'>" & _
"<SourceUrl>" + strLocalFile + "</SourceUrl>" & _
"<DestinationUrls>" & _
"<string>" + spBASE_URL + spDOC_LIB + "/" + spFILE_NAME + "</string>" & _
"</DestinationUrls>" & _
"<Fields>" & _
"<FieldInformation Type='Text' InternalName='Title' DisplayName='Title' Value='this is the title value' />" & _
"<FieldInformation Type='Choice' InternalName='Our_x0020_Status' DisplayName='Our Document Status' Value='Ready-to-distribute' />" & _
"<FieldInformation Type='Text' InternalName='ContentTypeId' DisplayName='Content Type ID' Value='" + spCONTENT_TYPE + "' />" & _
"</Fields>" & _
"<Stream>" + EncodedFile + "</Stream>" & _
"</CopyIntoItems>" & _
"</soap:Body>" & _
"</soap:Envelope>"
ObjectHTTP.Open "Get", strURLService, False
ObjectHTTP.SetRequestHeader "Content-Type", "text/xml; charset=utf-8"
ObjectHTTP.SetRequestHeader "SOAPAction", strSOAPAction
ObjectHTTP.Send strSOAPCommand
MsgBox (ObjectHTTP.responseText)
End Sub