Excel VBA code to upload a file to SharePoint Online

Hi

I'm using Outlook to send the file on SharePoint everyday with an Excel file i have.

You would just have to set an SharePoint email and use the macro to push your file with a code like

                
    ''''''''''''''''''''''''''''   Send info to Sharepoint   ''''''''''''''''''''''''''''''''''''''''
                On Error Resume Next
                    Application.ScreenUpdating = False
                    Set WB = Application.ActiveWorkbook
                    ActiveSheet.Copy
                    Set Wb2 = Application.ActiveWorkbook
                    Select Case WB.FileFormat
                        Case xlOpenXMLWorkbook:
                        xFile = ".xlsx"
                        xFormat = xlOpenXMLWorkbook
                        Case xlOpenXMLWorkbookMacroEnabled:
                        If Wb2.HasVBProject Then
                            xFile = ".xlsm"
                            xFormat = xlOpenXMLWorkbookMacroEnabled
                        Else
                            xFile = ".xlsx"
                            xFormat = xlOpenXMLWorkbook
                        End If
                        Case Excel8:
                        xFile = ".xls"
                        xFormat = Excel8
                        Case xlExcel12:
                        xFile = ".xlsb"
                        xFormat = xlExcel12
                    End Select
                    FilePath = Environ$("temp") & "\"
                    FileName = ws.Range("D" & Target.Row) & " " & WB.Name & Format(Now, "dd-mmm-yy h-mm-ss")
                    Set OutlookApp = CreateObject("Outlook.Application")
                    Set OutlookMail = OutlookApp.CreateItem(0)
                    Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
                    With OutlookMail

                    .To = "email address"

                    .Bcc = ""
                    .Subject = "DC: " & ws.Range("A" & Target.Row) & " BOL: " & ws.Range("D" & Target.Row) & "  Line#  " & WS2.Range("D" & MaxRow2) & " Carrier: " & ws.Range("AF" & Target.Row) 'change to AF
                    .Body = "In file: " & WB.Name & "    Line#  " & WS2.Range("D" & MaxRow2) & "  Driver: " & ws.Range("AE" & Target.Row) & "  Tractor: " & ws.Range("AD" & Target.Row)
                    .Attachments.Add Wb2.FullName
                    .Send
                End With
                Wb2.Close
                Kill FilePath & FileName & xFile
                Set OutlookMail = Nothing
                Set OutlookApp = Nothing

                
                Sheets("Final").Select
            Application.ScreenUpdating = True

Select allOpen in new window

For me, it works great.

Let me know if this help.

At the end. a simple code to send the excel file by email would probably do:
Example

 'Variable declaration
    Dim oApp As Object, _
    oMail As Object, _
    WB As Workbook, _
    FileName As String, MailSub As String, MailTxt As String
     
     '*************************************************  ********
     'Set email details; Comment out if not required
    Const MailTo = "sharepoint email address"
    Const MailCC = "email address"
    Const MailBCC = "email address"
    MailSub = "Please review SharePoint version " & Range("Subject")
    MailTxt = "I have attached " & Range("Subject")
     '*************************************************  ********
     
     'Turns off screen updating
    Application.ScreenUpdating = False
     
     'Makes a copy of the active sheet and save it to
     'a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook
    FileName = Range("A1") & " Text.xls"
    On Error Resume Next
    Kill "C:\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:="C:\Users\wilder1626\Desktop\" & FileName
     
     'Creates and shows the outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        .To = MailTo
        .Cc = MailCC
        .Bcc = MailBCC
        .Subject = MailSub
        .Body = MailTxt
        .Attachments.Add WB.FullName
        .Display
        .send
    End With
     
     'Deletes the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
     
     'Restores screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing

Select allOpen in new window

Hi Jean-Marc (Wilder1626), thank you so much for your fast response, I'll try the code and let you know if I can meet the requirement. I appreciate a lot your time for providing me part of the solution. My goal is to be able to user credentials and access a SharePoint list or library to store the document.

I'll look into the SharePoint + Outlook (mailbox) integration to see if I twist this code to meet the requisite. Thanks!

I really need to upload the file directly to a SharePoint library, this requirement is tied up with a Dynamics CRM integration I'm working on.

In this case, you may want to look at this link: VBA Code to Upload/Download Files to/from sharepoint Library

This may be what you are looking for. I will also test it on my end. :)

it looks great but it's missing the user authentication, thank you so much for helping me out. We are almost there.... ;)

Hi again

I did some research and testing today, and I may have found something.

Here it is, if you also want to test on your end

Function WebUploadFile(file, url)
'Function WebUploadFile(file, url, user, pass)


'Use this function call to upload a single file
' WebUploadFile "C:\Wilder1626.xlsx", "http://server/folder/Wilder1626.xlsx", "domain\user", "password"

   Dim objXMLHTTP, objADOStream, arrbuffer

   Set objADOStream = CreateObject("ADODB.Stream")
   objADOStream.Open
   objADOStream.Type = 1
   objADOStream.LoadFromFile file
   arrbuffer = objADOStream.Read()

   Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   'objXMLHTTP.Open "PUT", url, False, user, pass
   objXMLHTTP.Open "PUT", url, False
   objXMLHTTP.Send arrbuffer

   Set objADOStream = Nothing
   Set objXMLHTTP = Nothing

End Function

Select allOpen in new window

Hi again

I was just able to upload an excel file into sharepoint, and without any password also. I just need to be log on the server.

But you can also tweak it to what you may also need.

What i did was:


***Find the path where to save your file in SharePoint.***
1- Open SharePoint
2- Go directly to the folder where you would like to save your file
3- then Click on Action / Open with Window Explorer
4- Get the Location address below. You will use it for your macro later.

Once done, you can now start the macro setting.

***Macro Settings***
I Used the below macro and it work very well i must say:

Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object

SharepointAddress = "Put location path from step 4"           ' Where you will enter your location path
LocalAddress = "your file path"                                      ' Where you will enter the file path, ex: Excel file
Set objNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists(LocalAddress) Then
FS.CopyFile LocalAddress, SharepointAddress
End If
Set objNet = Nothing
Set FS = Nothing

Select allOpen in new window

Let me know what you think :)

I'll try this on monday, I will keep you posted, thank you Jean, have great weekend

I'm trying your code now... I keep you posted. Thanks and have a great day!

can't wait to get your feedback ! :)

Hi Jean, with this code, I don't need the previous snippet right?

Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object

SharepointAddress = "Put location path from step 4"           ' Where you will enter your location path
LocalAddress = "your file path"                                      ' Where you will enter the file path, ex: Excel file
Set objNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists(LocalAddress) Then
FS.CopyFile LocalAddress, SharepointAddress
End If
Set objNet = Nothing
Set FS = Nothing

//previous snippet 
Function WebUploadFile(file, url)
'Function WebUploadFile(file, url, user, pass)


'Use this function call to upload a single file
' WebUploadFile "C:\Wilder1626.xlsx", "http://server/folder/Wilder1626.xlsx", "domain\user", "password"

   Dim objXMLHTTP, objADOStream, arrbuffer

   Set objADOStream = CreateObject("ADODB.Stream")
   objADOStream.Open
   objADOStream.Type = 1
   objADOStream.LoadFromFile file
   arrbuffer = objADOStream.Read()

   Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   'objXMLHTTP.Open "PUT", url, False, user, pass
   objXMLHTTP.Open "PUT", url, False
   objXMLHTTP.Send arrbuffer

   Set objADOStream = Nothing
   Set objXMLHTTP = Nothing

End Function
 

Select allOpen in new window

correct. you don't need it.

@wilder1626 I get an error when I execute the code

On line: FS.CopyFile LocalAddress, SharepointAddress

my variables look like this;
SharepointAddress = "https:/mysite.sharepoint.com/sites/xyz-uat/a1docsuat" 
LocalAddress = "c:\temp.pdf"

i mean...
 SharepointAddress = "https://mysite.sharepoint.com/sites/xyz-uat/a1docsuat"

If I change the
SharepointAddress = "\\mysite.sharepoint.com\sites\xyz-uat\a1docsuat"

I get an Permision Denied error.

the sharepoint address looks like this...

SharepointAddress = "//mysite.sharepoint.com@SSL/DavWWWRoot/sites/xyz-uat"

I have the sharepoint library open in the browser, I'm not sure how to troubleshoot this issue. Please advise,  thank you!

Let me do another test, and i will comeback to you by tomorrow.

Sorry for the delay.

No worries, thanks a lot for your assistance.

Awesome, I'll test it early in the morning and let you know. Have a great day!!

it runs, don't return errors but no file is uploaded.

It works, thank you so much. I missed something on that path. you're rockstar buddy! :)

I'm glad i was able to help.

Have a nice one!!!! :)

Hi,
  I tried the above code but faced with the runtime error 5 'Invalid Procedure call or argument ' in the below line:

 FS.CopyFile LocalAddress, SharePointAddress

Please please help me out.

Hi Trina,

Do you see the blue 'Ask a related question' button?  Click that to ask your own question please.

eg