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

Question

我有一个 excel 文件，我需要单击按钮将其从一个文件夹移动到另一个文件夹。 目前我有以下代码。

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

getProjectFolder返回我要将文件移动到的文件夹的路径（包括文件的新名称）。

这在FSO.MoveFile行失败，错误代码为 70，“Permission Denied”。 我确信这是因为在打开文件时无法移动或重命名文件。 我在尝试移动它之前尝试关闭文件夹，但这显然结束了 sub 而没有在ActiveWorkbooks.Close之后执行任何行。

有没有办法在不使用一些外部文件/代码的情况下实现我想要做的事情？ 我希望用户能够按下工作表上的按钮，然后将该工作表移动到单独的文件夹中。 这可能吗？ 我唯一的其他想法是使用 SaveAs 方法将文件保存到正确的位置，然后从原始文件夹中删除原始文件。 这似乎是一个相当不雅的解决方案，我不知道这怎么可能。

任何想法、提示、技巧、解决方法等都将受到赞赏。

Answer 1

轻松搞定！ 尝试如下，您可以将其保存在新文件夹中，然后继续删除旧文件。

    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

希望它可以帮助你！

Answer 2

根据 Hiran Travassos 的回答，我缩短了他的代码并使其更具体地解决了这个问题。

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

即使在启动代码的原始工作簿因滥用Application.OnTime而关闭之后，您也可以使用一个技巧继续执行代码，但这有点挑剔。