Second Life of a Hungarian SharePoint Geek

May 16, 2016

How to Copy a Document between Folders of a SharePoint Document Library using VBA and REST

Filed under: REST, SP 2013, VBA — Tags: , , — Peter Holpar @ 15:59

One of our customers wanted to copy Office documents (.docx, .xlsx, .xlsm) from a folder of a SharePoint document library into another one using Excel macros. The Excel document, that contains the macro, is located in the root of the document library.

For some mysterious reason, that we could not have really identified, the files were created having a size of 0 bytes at the target location for these types of files, when they were copied using the “classical” methods (more on these methods a bit later), although other file types, like text or image files could be copied without problem.

So what are those classical methods, most of them available already in other blogs or forum threads?

Version 1

Copy the files using the FileSystemObject.

You should add a reference to the Windows Script Host Obejct Model library in VBA.

Note: We convert the URL of the document library into an UNC form in the ConvertPath method. That means, it converts a URL like http://YourSharePoint/DocLib into \\YourSharePoint\DocLib. However, if you have configured HTTPS for your SharePoint, you need to convert the URL into this form: \\YourSharePoint@SSL\DavWWWRoot\DocLib. In this case, you should either extend the ConvertPath method, or simply use a fix path in your code as a quick and dirty solution.

Function ConvertPath(path) As String
  ConvertPath = Replace(path, " ", "%20")
  ConvertPath = Replace(ConvertPath, "/", "\")
  ConvertPath = Replace(ConvertPath, "http:", "")
End Function

Private Sub CopyFiles1()
  Dim sDocPath As String
  Dim sDocPathConv As String
  Dim sFileName As String
  Dim sTargetPath As String
  Dim sSourcePath As String
  Dim fso As FileSystemObject

  Set fso = New FileSystemObject ‘ CreateObject("Scripting.FileSystemObject")
  sDocPath = ThisWorkbook.Path
  sFileName = "WorkBook.xlsx"

  sDocPathConv = ConvertPath(sDocPath)

  sSourcePath = sDocPathConv  & "\Folder1\" & sFileName
  Debug.Print "Source: " & sSourcePath
       
  sTargetPath = sDocPathConv  & "\Folder2\" & sFileName
  Debug.Print "Target: " & sTargetPath

  fso.CopyFile sSourcePath, sTargetPath, True

End Sub

Version 2

Copy the files using SharePoint document library as mapped drive using the FileSystemObject.

In addition to the Windows Script Host Obejct Model library, you need an additional reference to the WSHControllerLibrary as well.

See a similar sample here.

The MapNetworkDrive method seems to handle the conversion of the SharePoint doc. lib. URL into an UNC form, but you might still need to invoke the conversion method if you receive this error on mapping the drive:

800704DC – The operation being requested was not performed because the user has not been authenticated

Private Sub CopyFiles2()
  Dim sDocPath As String
  Dim sFileName As String
  Dim sTargetPath As String
  Dim sSourcePath As String
  Dim sDriveLetter As String
  Dim fso As FileSystemObject
  Dim net As WshNetwork

  ‘ drive letter should be available (not mapped to a share already, to avoid error ‘80070055 – The local device is already in use’)
  sDriveLetter = "S:"
  sFileName = "WorkBook.xlsx"
   
  Set fso = New FileSystemObject ‘ CreateObject("Scripting.FileSystemObject")
  sDocPath = ThisWorkbook.Path

  ‘sDocPath = ConvertPath(sDocPath)

  Set net = New WshNetwork ‘ CreateObject("WScript.Network")
  Debug.Print "Path to map: " & sDocPath
  net.MapNetworkDrive sDriveLetter, sDocPath

  sSourcePath = sDriveLetter & "\Folder1\" & sFileName
  Debug.Print "Source: " & sSourcePath

  sTargetPath = sDriveLetter "\Folder2\" & sFileName
  Debug.Print "Target: " & sTargetPath

  fso.CopyFile sSourcePath, sTargetPath, True

  net.RemoveNetworkDrive sDriveLetter

  Set net = Nothing
  Set fso = Nothing

End Sub

Version 3

We could have downloaded the file, and upload it via web service calls, but I felt this second part simply far too complex.

Version 4

We have used a method to create temporary folder names:

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
  (ByVal lpszPath As String, _
  ByVal lpPrefixString As String, _
  ByVal wUnique As Long, _
  ByVal lpTempFileName As String) As Long

Public Function Get_Temp_File_Name( _
  Optional sPrefix As String = "VBA", _
  Optional sExtension As String = "") As String

  Dim sTmpPath As String * 512
  Dim sTmpName As String * 576
  Dim nRet As Long
  Dim F As String

  nRet = GetTempPath(512, sTmpPath)
  If (nRet > 0 And nRet < 512) Then
    nRet = GetTempFileName(sTmpPath, sPrefix, 0, sTmpName)
    If nRet <> 0 Then F = Left$(sTmpName, InStr(sTmpName, vbNullChar) – 1)
    If sExtension > "" Then
      Kill F
      If Right(F, 4) = ".tmp" Then F = Left(F, Len(F) – 4)
      F = F & sExtension
    End If

    Get_Temp_File_Name = F
  End If

End Function

Then, instead of copying directly between the document library folders in Version 2 and 3, we copied the file first from source folder to the local temporary file in the file system, then from the temporary file to the target folder.

That means, instead of

fso.CopyFile sSourcePath, sTargetPath, True

we used this:

Dim tempPath As String

tempPath = Get_Temp_File_Name
Debug.Print "Temp path: " & tempPath

fso.CopyFile sSourcePath, tempPath, True
fso.CopyFile tempPath, sTargetPath, True
fso.DeleteFile tempPath

It did not help to remedy our problem with the empty Office files created during the copy operation.

Version 5

This is our last sample code, and it is the one that works at the customer without problem with the file size / content. In this case we utilize the getfilebyserverrelativeurl and copyto methods of the files and folders REST API.

Using this method has a further benefit, that – depending on the file size – might be even a significant one. In contrast with the other methods described earlier, this one does not download / upload the file content. It sends only a command to the server to copy the file, after we perform the authentication in the GetDigest method.

For this example to work, you need a reference to the Microsoft XML, v6.0 library in VBA.

Private Function GetDigest(url As String)
  Dim http As MSXML2.XMLHTTP

  Set http = New MSXML2.XMLHTTP

  http.Open "POST", url + "/_api/contextinfo", False
  http.setRequestHeader "ContentType", "application/json;odata=verbose"
  http.send ""

  GetDigest = http.responseXML.SelectSingleNode("//d:FormDigestValue").nodeTypedValue
 
  Set http = Nothing

End Function

Private Sub CopyFiles3()
  Dim webAppUrl As String
  Dim serverRelUrlOfSite As String
  Dim siteUrl As String
  Dim docLibName As String
  Dim serverRelUrlOfDocLib As String
  Dim sourcePath As String
  Dim targetPath As String

  Dim http As MSXML2.XMLHTTP
  Dim digest As String
  Dim url As String

  webAppUrl = "http://YourSharePoint&quot;
  serverRelUrlOfSite = "/subsite1/subsite1.2"
  docLibName = "YourDocLib"
 
sFileName = "WorkBook.xlsx"

  siteUrl = webAppUrl & serverRelUrlOfSite
  serverRelUrlOfDocLib = serverRelUrlOfSite & "/" & docLibName

  sourcePath = "/Folder1/" & sFileName
  Debug.Print "Source: " & sourcePath

  targetPath = "/Folder2/" & sFileName"
  Debug.Print "Target: " & targetPath

  ‘ get the authentication digest
  digest = GetDigest(siteUrl)
  Set http = New MSXML2.XMLHTTP

  url = siteUrl & "/_api/web/getfilebyserverrelativeurl(‘" & serverRelUrlOfDocLib & sourcePath & "’)/copyto(strnewurl=’" & serverRelUrlOfDocLib & targetPath & "’,boverwrite=true)"

  http.Open "POST", url, False
  http.setRequestHeader "X-RequestDigest", digest

  http.send ""
  
  Set http = Nothing

End Sub

If you need to move the files instead of copying, you should simply use the MoveTo method instead of the CopyTo method.

Note: As you see, this code does not contain any error handling, so please extend it if you would like to use it in production.

Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at WordPress.com.

%d bloggers like this: