vba - 解決問題的方法excel保存臨時文件

Question

保存特定工作簿時，Excel創建臨時文件而不是保存數據（不顯示錯誤或警告消息）。症狀大體上與本文中描述的相同： microsoft-excel-returns-the-error-document-not-saved-after-generating-a-2gb-temp-file 我嘗試了幾種解決方案，但決定實施一種解決方法，因爲「另存爲」工作正常。

下面的代碼根據以文件名結尾的值（例如myFile V1.xlsm）執行「另存爲」，每次保存工作簿時宏將添加一個增量字符（a到z）。 （例如myFile V1a.xlsm）。

該宏在標準模塊中正常工作，但會導致Excel在移至「thisWorkbook」時「停止響應」。我通過將其保存在標準模塊中並將宏組合鍵'control-s'分配給它來解決這個問題。仍然有興趣知道是否可以在'thisWorkbook'中工作。

此變通辦法的缺點是每個增量保存會阻塞'最近的文件'列表。從最近的文件歷史記錄中刪除以前的文件名稱會很好，但這似乎不可能通過VBA來完成。 （VBA - How do I remove a file from the recent documents list in excel 2007?）。有什麼建議麼？

的Windows 10時，Excel 2016（16.0.6868.2060版）

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

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 

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 

End If 

'potential code to remove oldFilename from 'Recent File' list 

End Sub 

Answer 1

我在Excel 2010中測試了這個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 

Answer 2

由於羅賓工作方案如下：

更新INTIAL代碼：

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