Move folder across network using vba

Question

I am trying to figure out how to properly move folders on a Network Share using VBA code from an MS Access Form.

Currently I am trying to use the FileSystemObject.MoveFolder method but keep running into a "Permissions Denied" error.

I have referenced this SO question and none of the top suggestions worked. Permission denied on CopyFile in VBS

I have verified that the SourcePath and the DestinationPath both are valid by using this function to MoveFolders on my local machine. I have also verified that both Folders have the appropriate network permissions. See Below

So my question is, is there a way to provide credentials with the FileSystemObject? or should I be using a different function entirely?

EDIT:

I have verified that I can move the folders manually. I have tried the function with and without files in the source folder.

I also have tried hardcoding the source and destination paths into the FSO.MoveFolder Command

Private Sub Check6_AfterUpdate()

    On Error GoTo Err_DormantHandler
    Dim response As String
    Dim client As String
    Dim FSO As Object
    Dim fromPath As String
    Dim toPath As String
    Set FSO = CreateObject("Scripting.Filesystemobject")

    client = Me.CustomerName.Value
    fromPath = "P:\__Active_Clients\" & client
    toPath = "R:\Dormant_Clients\"

    If Me.Check6.Value = True Then
        response = MsgBox("Would you like to automatically move the " & client & " folder to the dormant folder?", vbYesNo)

        If response = vbYes Then
            If FSO.FolderExists(fromPath) = False Then
                MsgBox fromPath & " doesn't exist."
                Exit Sub
            End If
            If FSO.FolderExists(toPath) = False Then
                MsgBox toPath & " doesn't exist."
                Exit Sub
            End If

            FSO.MoveFolder source:=fromPath, destination:=toPath
            MsgBox "The customer folder has been moved to " & vbNewLine & toPath, vbOKOnly
        End If

        If response = vbNo Then
            MsgBox "The customer folder will NOT be moved to dormant"
            Exit Sub
        End If
    End If


Exit_DormantHandler:
    Exit Sub

Err_DormantHandler:
    MsgBox "Error# " & Err & vbNewLine & "Description: " & Error$
    Resume Exit_DormantHandler

End Sub

Answer 1

I'd try with xcopy from windows :

Sub Test()
  XCopy "C:\source", "C:\destination\", elevated:=False
End Sub

Public Sub XCopy(source As String, destination As String, Optional elevated = False)
  Static shell As Object
  If shell Is Nothing Then Set shell = CreateObject("Shell.Application")

  Dim vArguments, vOperation
  vArguments = "/E /Y """ & source & """ """ & destination & """"
  vOperation = IIf(elevated, "runas", "")

  shell.ShellExecute "xcopy.exe", vArguments, "", vOperation, 0
End Sub

Answer 2

You could try the batch file route, do you get permission errors with this? You'll need the scripting reference, but it looks like you already have that.

Note the wait is important here, without the pause this will not work. Also note the trailing slash only in the newDir, not the orig

Sub Main()
    Dim origDir As String: origDir = "C:\Users\thomas.preston\Original"
    Dim newDir As String: newDir = "C:\Users\thomas.preston\Destination\"
    Dim batDir As String: batDir = "C:\Users\thomas.preston\Desktop"
    Dim contents As String

    If Not DirectoryExists(origDir) Then
        MsgBox "Directory deos not exist: " & vbCrLf & origDir
        Exit Sub
    Else
        contents = "move """ & origDir & """ """ & newDir & """"
        MakeBat batDir & "\" & "ILikeToLoveItMoveIt.bat", contents
        FireBat batDir & "\" & "ILikeToLoveItMoveIt.bat"
        Application.Wait DateAdd("S", 2, Now)
    End If

    If DirectoryExists(newDir & folderName(origDir)) = True Then MsgBox "Greeeeeeat success" Else MsgBox "doh"
    If FileExists(batDir & "\" & "ILikeToLoveItMoveIt.bat") = True Then Kill batDir & "\" & "ILikeToLoveItMoveIt.bat"
End Sub

Function folderName(ByRef origDir As String) As String
    folderName = Right(origDir, Len(origDir) - InStrRev(origDir, "\", , vbTextCompare))
End Function

Sub MakeBat(ByVal FileName As String, ByVal contents As String)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile(FileName, True)
    a.WriteLine (contents)
    a.Close
End Sub

Function FireBat(ByRef FullName As String)
If dir(FullName, vbNormal) <> "" Then
    Call Shell(FullName, vbNormalFocus)
Else
    MsgBox "Bat not created"
End If
End Function

Function FileExists(ByVal FullPath As String) As Boolean
If dir(FullPath) <> "" Then
    FileExists = True
Else
    FileExists = False
End If
End Function

Function DirectoryExists(ByVal FullPath As String) As Boolean
If dir(FullPath, vbDirectory) <> "" Then
    DirectoryExists = True
Else
    DirectoryExists = False
End If
End Function