Go Back   Access World Forums > Microsoft Access Reference > Code Repository

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 11-14-2017, 03:32 AM   #1
Dystonia
Access 2002, 2010, 2016
 
Join Date: Nov 2017
Location: Rainy part of the UK
Posts: 17
Thanks: 0
Thanked 3 Times in 3 Posts
Dystonia is on a distinguished road
VBA to upload files to Sharepoint and set meta tags (if required)

Hi
 
I recently had to come up with some code to upload a ZIP file to a sharepoint site and set (existing) document meta tags.
 
I thought it would be reasonably straightforward use Microsoft Access 2010 to take a ZIP file produced by a Microsoft operating system and upload it to Microsoft Sharepoint 2013 and set a few document properties - how wrong could I be !
 
As this was/is somewhat beyond my usual database knowledge base, I had to do a lot of Googling and play with snippets of code from a plethora of websites before I finally got something that enabled upload of TXT files as well as binary files such as ZIPs,PDFs, XLSXs etc.

The internet is full of posts about code for one Sharepoint site not working at another so there are no guarantees with the function below but it may be a base to build on and help others avoid the blind alleys and brick walls I encountered.
   
As meta tags can only be set using an ADO recordset, make sure your VBA references include :
 
Microsoft ActiveX Data objects 6.1 Library (or higher)
 
The rem statements detail what parameters need to be passed into the function.

Code:
Function UploadFileToSharePoint(ByVal Sourcefile As String, ByVal SharepointURL As String, ByVal DocumentsURL As String, _
ByVal UserName As String, ByVal Password As String, Optional ByVal DocumentsGUID As String, Optional ByRef MetaTags)
Rem*******************************************
Rem Parameters passed into this function
Rem
Rem SourceFileName : Full details of file to upload eg "C:\Documents\Fri 20 Oct 2017 Daily Plan.ZIP"
Rem
Rem Ensure you add trailing slashes to your URLs
Rem
Rem SharepointURL : Note this omits the actual documents folder element eg
rem "https://companyname.sharepoint.com/logistics/"
Rem
Rem DocumentsURL :  Actual Documents repository element eg "Shared Documents/"
Rem
Rem UserName : In Email format eg firstname.lastname@company.com
Rem
Rem Password : this is case sensitive so beware
Rem
Rem IF you want to set any EXISTING meta tags you will need the following
Rem
Rem DocumentsGUID : The GUID of DocumentsURL eg
Rem "{47DBD8C4-BCB4-40D9-8259-487E0504D058}"
Rem Google will tell you how to find this out if you don't know
Rem
Rem If there are no EXISTING meta tags to set, the above is not needed
Rem
Rem Optional two dimensional Variant array to set any EXISTING meta tags.
Rem Element 1 = Meta tag name : Element 2 = Mata tag value eg.
Rem Matatag(0,1) = "Document Expiry": Metatag(0,2) = 20/10/2017
Rem Metatag(1,1) = "Confidential"    : Metatag(1,2) = False
Rem
Rem if there are no meta tags to set the above is not needed
Rem*******************************************
    
    On Error GoTo oops 'oops something went wrong
    
Rem*******************************************
Rem Create FSO Object and get source file
Rem*******************************************

    Dim FSO, FSOFile As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSOFile = FSO.GetFile(Sourcefile)

Rem*******************************************
Rem Send Text File To Share Point
Rem*******************************************

    Dim XML As Object

Rem*******************************************
Rem Send Text/CSV File To Share Point
Rem*******************************************

    If UCase(FSOFile.Name) Like "*.TXT" Or UCase(FSOFile.Name) Like "*.CSV" Then
        Dim TextStreamIn As Variant
        Dim Body As Variant
        
        Set TextStreamIn = FSOFile.OpenAsTextStream
        
        Body = TextStreamIn.ReadAll
        TextStreamIn.Close
        
        Set XML = CreateObject("MSXML2.XMLHTTP.4.0")
        
        With XML
            .Open "PUT", SharepointURL & DocumentsURL & FSOFile.Name, False, UserName, Password
            .send Body
        End With
        
        If IsMissing(MetaTags) Then
            GoTo HouseKeep
        Else
            GoTo SetMetaTags
        End If
     
   End If
    
Rem*******************************************
Rem Binary File Get File Length
Rem*******************************************
   
    Dim FileLength As Long
    
    FileLength = FileLen(Sourcefile) - 1
   
Rem*******************************************
Rem Read Binary File Into Byte Array
Rem*******************************************
   
    Dim BArray() As Byte
   
    ReDim BArray(FileLength)
    
    Close
    
    Open Sourcefile For Binary As #1
    Get #1, , BArray
    Close #1
  
Rem*******************************************
Rem Convert BArray into Variant
Rem*******************************************
 
    Dim BinData As Variant
    
    BinData = BArray
    
Rem*******************************************
Rem Open XML Object
Rem*******************************************
       
    Set XML = CreateObject("Microsoft.XMLHTTP")
    
    With XML
       .Open "PUT", SharepointURL & DocumentsURL & FSOFile.Name, False, UserName, Password
       .send BinData
    End With
    
Rem*******************************************
Rem If meta tags not required tidy up and exit
Rem*******************************************
    
    If IsMissing(MetaTags) Then
        GoTo HouseKeep
    End If
        
SetMetaTags:
Rem*******************************************
Rem Compile Connection String
Rem*******************************************
    
    Dim CS As String 'ADO connection String
    
    CS = "Provider=Microsoft.ACE.OLEDB.12.0;"
    CS = CS & "WSS;"
    CS = CS & "IMEX=0;"
    CS = CS & "RetrieveIds=Yes;"
    CS = CS & "DATABASE=" & SharepointURL & ";"
    CS = CS & "LIST=" & DocumentsGUID & ";"
    
Rem*******************************************
Rem Establish Connection
Rem*******************************************
     
    Dim CN As ADODB.Connection
    
    Set CN = New ADODB.Connection
    
    With CN
        .ConnectionString = CS
        .Open
    End With

Rem*******************************************
Rem Prepare Recordset
Rem*******************************************
    
    Dim rs1 As ADODB.Recordset
    
    Set rs1 = New ADODB.Recordset
    
Rem*******************************************
Rem Open Sharepoint Document List as Recordset
Rem*******************************************
    
    Dim s1 As String
    
    s1 = "SELECT * FROM [Documents Repository Name] WHERE [Name] Like '" & FSOFile.Name & "#%';" '% is the equivament of asterisk 
 
    rs1.Open s1, CN, adOpenKeyset, adLockOptimistic
     
Rem*******************************************
Rem Wait for Sharepoint to catch up with Access
Rem*******************************************
    
    Do While rs1.RecordCount < 1
        rs1.Requery
    Loop
    
    rs1.MoveFirst
    
Rem*******************************************
Rem Loop Through Meta Tags
Rem element 1 = Meta Tag name
Rem element 2 = Mata tag value
Rem*******************************************
    
    Dim b As Byte
    
    For b = LBound(MetaTags) To UBound(MetaTags)
    
        rs1.Fields(MetaTags(b, 1)) = MetaTags(b, 2)
        
    Next b
        
    rs1.Update
    rs1.Close
    
    Set CN = Nothing
    Set rs1 = Nothing
    
HouseKeep:
Rem*******************************************
Rem HouseKeep
Rem*******************************************
    
    Set FSO = Nothing
    Set FSOFile = Nothing
    Set XML = Nothing

    UploadFileToSharePoint = "SUCCESS"

    Exit Function

oops:
Rem*******************************************
Rem oops Something when wrong
Rem*******************************************

    MsgBox Error$

    UploadFileToSharePoint = "ERROR"
       
End Function

Dystonia is offline   Reply With Quote
Reply

Tags
sharepoint 2013 , uploading files

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Question MS Access 2010 VBA - Upload to SharePoint 2013 Doc Lib davestuart General 0 08-13-2015 12:37 PM
upload files to a web site and download files focus10 Modules & VBA 2 12-28-2012 04:03 AM
Can you upload an Access Web DB to Sharepoint 2010 foundation? GBalcom Other Software 0 09-11-2012 08:53 AM
Getting Meta Tags ezykiwi Excel 0 12-08-2006 07:01 PM
Upload files into a form and for those files to be stored benc Forms 0 12-31-2001 02:56 AM




All times are GMT -8. The time now is 04:32 PM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Sponsored Links

How to advertise

Media Kit


Powered by vBulletin®
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World