如何使用自己的 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而關閉之后，您也可以使用一個技巧繼續執行代碼，但這有點挑剔。