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"
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.
