如何使用自己的 VBA 代码移动 excel 文件？

Question

I have an excel file that I need to move from one folder to another at the click of the button. Currently I have the following code.

Private Sub btnReview_Click()
Dim FSO
Dim projectNumber As String
Dim fileSource As String
Dim fileDestination As String
projectNumber = Range("AI6").Value

    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    fileSource = ActiveWorkbook.path & "\" & ActiveWorkbook.Name

    fileDestination = getProjectFolder(projectNumber)
    '        ActiveWorkbook.Close True
    FSO.MoveFile fileSource, fileDestination
End Sub

Where getProjectFolder returns the path to the folder I want to move the file to(including the new name of the file).

This fails at the line FSO.MoveFile with error code 70, "Permission Denied". I am certain that this is because it isn't possible to move or rename a file while it is open. I have tried closing the folder before trying to move it, but that obviously ends the sub without executing any lines after the ActiveWorkbooks.Close .

Is there any way to achieve what I am trying to do without using some external file/code? I want the user to be able to push a button on a sheet, and then that sheet is moved to a separate folder. Is this possible? The only other ideas that I've had is to use the SaveAs method to save the file to the correct location and then delete the original file from the original folder. That seems to be a rather inelegant solution and I don't know how that would even be possible.

Any thoughts, tips, tricks, workarounds, etc. are appreciated.

Answer 1

Easily done! Try as below, you can save it in a new folder and then proceed to delete the old file.

    Public Sub MoveMeToANewWorld()
        currentName = ThisWorkbook.Name,
        currentPathAndName = ThisWorkbook.FullName 
        currentPath = Replace(currentPathAndName, currentName, "")
        newPath = "NewFolder\"
        
    With ThisWorkbook
        .SaveAs Filename:= currentPath & newPath & currentName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End with

'Deleting the OldFile
    With New FileSystemObject
        If .FileExists(currentPathAndName) Then
            .DeleteFile currentPathAndName 
        End If
    End With
    
    End Sub

Hope it helps you out!

Answer 2

Based on Hiran Travassos's answer I shortened his code and made it more specific to the question.

Public Sub moveMyself()
    Dim oldFile As String
    Dim projectNumber As String
    oldFile = ThisWorkbook.FullName
    projectNumber = Range("AI6").Value

    ThisWorkbook.SaveAs getProjectFolder(projectNumber), 52
    
    'Deleting the old file
    With New FileSystemObject
        .DeleteFile oldFile
    End With

End Sub

Also there is a trick you can use to continue executing code even after the original workbook that started the code got closed by abusing Application.OnTime , but it's a bit finicky.