只读已打开的用VBA保存的Excel文件，但根本不保存？

Question

我有一个excel模板，建议向用户打开时以只读方式打开（我有打开文件的密码，以便可以更改/编辑文件）。 我有一个vba脚本，用于保存只读的打开文件。

当我以正常方式保存文件时（菜单>另存为>选择文件>保存），excel会返回一条消息，告诉我该文件无法保存，因为它已以只读方式打开。

当我使用脚本时，会弹出一个对话框，显示所需目录的正确文件名，并且可以进行保存（以只读方式打开，仍然可以使用相同的文件名进行保存）。 完全没有错误。

但是当我现在查看目录时，我已更新和保存的大多数文件都没有更新的“上次编辑日期/时间”。 当我打开文件时，所做的所有更改都不再存在于文件中。

尽管文件以只读方式打开，但VBA是否有可能说已使用相同的文件名保存了文件，但实际上没有保存任何内容？

这是另存为的代码：

Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant

  Windows(mytemplate).Activate

  On Error GoTo Err_

  MsgBox ("Bezig met vernieuwen")

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

'  Call SheetOpschonen

  Call datawissen
  Call dataplaatsen
  Call kolomtitels
  Call toevoegen
  Call maaktabel
  Call refreshpivots

workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:="M:\Commercie\Marktdata\IRi\Segment ontwikkeling\")

MsgBox workbook_Name

If workbook_Name <> False Then

    ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50

End If

Exit_:
  Application.StatusBar = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Exit Sub

Err_:
  Call MsgBox(Err.Number & vbCrLf & Err.Description)
  Resume Exit_

Application.Calculation = xlCalculationAutomatic

End Sub

它似乎可以工作，但是正如我发现的那样，当以只读方式打开文件时，它不起作用，尽管我看起来文件已保存，并且在以只读方式打开时可以覆盖原始文件。

更新2019-04-11 10:00 AM：

根据ZACK的建议，我将另存为代码调整为：

Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant

  Windows(mytemplate).Activate

  On Error GoTo Err_

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

'  Call SheetOpschonen

  Call datawissen
  Call dataplaatsen
  Call kolomtitels
  Call toevoegen
  Call maaktabel
  Call refreshpivots

If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite

workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:="M:\Commercie\Marktdata\IRi\Segment ontwikkeling\")

If workbook_Name <> False Then ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50


ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

Exit_:
  Application.StatusBar = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Exit Sub

Err_:
  Call MsgBox(Err.Number & vbCrLf & Err.Description)
  Resume Exit_

Application.Calculation = xlCalculationAutomatic

End Sub

打开一个只读文件并保存它，同时覆盖原始只读文件即可。 除此之外，我知道必须再次输入文件名。 如果以前使用原始文件名，则另存为弹出屏幕中将不再显示文件名。

更新2 2019-04-11 10:31 AM：

我还有一些其他的“另存为代码”来获取之前使用的正确文件名（在原始帖子中）。 我将此代码添加到我的主宏中，并测试了它是否有效。 现在，正确更改了文件访问权限，“另存为”弹出窗口在正确的目录中显示了正确的文件名，并且文件已保存。

结论：案件结案，问题已解决！

这是它的工作方式（对我而言）：

Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant
Dim workbookdirectory As String
Dim activewb As String

  Windows(mytemplate).Activate

  On Error GoTo Err_

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

'  Call SheetOpschonen

  Call datawissen
  Call dataplaatsen
  Call kolomtitels
  Call toevoegen
  Call maaktabel
  Call refreshpivots

If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite

activewb = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

workbookdirectory = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\"

workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:=workbookdirectory & activewb)

If workbook_Name <> False Then ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50

ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

Exit_:
  Application.StatusBar = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Exit Sub

Err_:
  Call MsgBox(Err.Number & vbCrLf & Err.Description)
  Resume Exit_

Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

您可以尝试的另一种解决方案是Zac所说的。 它将更改活动工作簿的访问权限，因此您可以运行代码，然后将其改回只读。

Sub saveas()
Dim workbook_Name As Variant
Dim location As String
Dim workbookdirectory As String
Dim activewb As String
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite     

         activewb = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

         workbookdirectory = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\"

         workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:=workbookdirectory & activewb)

         If workbook_Name = False Then ActiveWorkbook.saveas Filename:=activewb, FileFormat:=50

    ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
End Sub