vba-excel保存临时文件问题的解决方法

保存特定工作簿时，Excel会创建临时文件，而不是保存数据（不会显示错误或警告消息）。症状与本文描述的大致相同： 我尝试了几种解决方案，但决定实施变通方案，因为“另存为”可以正常工作

下面的代码执行“另存为”，基于文件名以值结尾（例如myFile V1.xlsm），每次保存工作簿时，宏都会添加一个增量字符（a到z）。（例如，myFile V1a.xlsm）

宏在标准模块中工作正常，但当移到“thisWorkbook”时，它会导致Excel“停止响应”。我通过将其保存在标准模块中并将组合键“control-s”分配给宏来“解决”这个问题。仍然有兴趣知道它是否可以在“thisWorkbook”中工作

这种解决方法的缺点是每次增量保存都会阻塞“最近使用的文件”列表。最好从最近的文件历史记录中删除以前的文件名，但这似乎不可能通过VBA实现。(). 有什么建议吗

Windows 10，Excel 2016（版本16.0.6868.2060）

---

我在Excel2010中测试了这个Sub，它适合我。我在删除文件后立即中断循环，因为我假设索引可能与循环不一致。一个更精确的变量可能会循环遍历最近的文件列表，创建一个要删除的索引集合，然后在该集合上反向迭代，依次删除每个条目

Public Sub RemoveRecentFile(strFileName As String)

    Dim collRecentFiles As Excel.RecentFiles
    Dim objRecentFile As Excel.RecentFile
    Dim intRecentFileCount As Integer
    Dim intCounter As Integer

    Set collRecentFiles = Application.RecentFiles
    intRecentFileCount = collRecentFiles.Count

    For intCounter = 1 To intRecentFileCount
        Set objRecentFile = collRecentFiles(intCounter)
        If objRecentFile.Name = strFileName Then
            objRecentFile.Delete
            Exit For
        End If
    Next intCounter

End Sub

---

感谢Robin，工作解决方案如下：

更新初始代码：

    Sub incrementSaveAs()
    'to avoid that other workbooks are saved (when assigned to shortkey control-S)
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then ActiveWorkbook.Save: Exit Sub

    Dim newFilename As String
    Dim oldFilename As String

        oldFilename = ActiveWorkbook.Name
        newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

        If IsNumeric(Right(newFilename, 1)) = True Then

            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & "a.xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
            'AddToMru:=True Added to update recent files history

        Else
            If Right(newFilename, 1) = "z" Then
                MsgBox "'z' reached, please save as new version"
                Exit Sub
            End If

            newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True

        End If

        RemoveRecentFile (ActiveWorkbook.Path & Application.PathSeparator & oldFilename)

    End Sub

---

谢谢你，罗宾！在将“objRecentFile.Name”更改为“objRecentFile.Path”后，我让它开始工作，还必须更新我的代码，在saveAs函数中添加“AddToMru:=True”属性，以使用新文件名更新最近的文件历史记录。将以anwser.BTW的形式发布整个解决方案。我怀疑我的excel文件因复制工作表中的宏框而损坏（在按下控制按钮时拖动宏框）。

    Sub incrementSaveAs()
    'to avoid that other workbooks are saved (when assigned to shortkey control-S)
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then ActiveWorkbook.Save: Exit Sub

    Dim newFilename As String
    Dim oldFilename As String

        oldFilename = ActiveWorkbook.Name
        newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

        If IsNumeric(Right(newFilename, 1)) = True Then

            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & "a.xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
            'AddToMru:=True Added to update recent files history

        Else
            If Right(newFilename, 1) = "z" Then
                MsgBox "'z' reached, please save as new version"
                Exit Sub
            End If

            newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
            ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True

        End If

        RemoveRecentFile (ActiveWorkbook.Path & Application.PathSeparator & oldFilename)

    End Sub

Public Sub RemoveRecentFile(strPathAndFileName As String)

    Dim collRecentFiles As Excel.RecentFiles
    Dim objRecentFile As Excel.RecentFile
    Dim intRecentFileCount As Integer
    Dim intCounter As Integer

    Set collRecentFiles = Application.RecentFiles
    intRecentFileCount = collRecentFiles.Count

    For intCounter = 1 To intRecentFileCount
        Set objRecentFile = collRecentFiles(intCounter)
        If objRecentFile.Path = strPathAndFileName Then
            objRecentFile.Delete
            Exit For
        End If
    Next intCounter

End Sub