Moving a folder over a network using vba

Question

I am trying to figure out how to properly move folders on a network using VBA code from an MS access form.

I am currently trying to use the FileSystemObject.MoveFolder method, but continue to work with the "Permissions Denied" error.

I referenced this SO question and none of the best suggestions worked. Deny CopyFile in VBS

I checked that SourcePath and DestinationPath are both valid using this function for MoveFolders on my local machine. I also confirmed that both folders have the appropriate network permissions. See below

So my question is: is there a way to provide credentials using a FileSystemObject? or should I use another function entirely?

EDIT:

, . .

hardcoding FSO.MoveFolder

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

xcopy :

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

, ? , , .

, wait , . newDir, 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