如果SaveAs位置已经打开,我得到1004错误

遇到一些VBA SaveAs代码的最终用户问题。

下面的代码为当前工作簿执行SaveAs ,允许用户select名称,closures新保存的文件并重新打开原始文件。 这是许多用户在一个Excel工作簿,许多人将不断打开/closures文件。

问题是当用户试图执行下面的代码以保存其他用户打开的文件时,该程序显示运行时错误“1004”:您不能保存与另一打开的工作簿具有相同的名称此工作簿或添加等等

有谁知道如何检查SaveAs目标是否已经打开,然后显示MsgBox “文件被另一个用户打开,请等到他们closures或select一个不同的文件名。

任何帮助将不胜感激,不能指出这一个!

 Sub ExportTrip() Dim ActSheet As Worksheet Dim ActBook As Workbook Dim CurrentFile As String Dim NewFile As String Application.ScreenUpdating = False ' Prevents screen refreshing. CurrentFile = ThisWorkbook.FullName ' saves filename of current workbook NewFile = Application.GetSaveAsFilename( _ InitialFileName:=Sheets("Master").Range("B5"), _ FileFilter:="ARMS Export *.xlsm (*.xlsm),") ' gets filename for exported workbook If NewFile <> "" And NewFile <> "False" Then 'if user doesn't pick name ActiveWorkbook.SaveAs Filename:=NewFile, _ FileFormat:=52, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook 'declares variable for open workbook Workbooks.Open CurrentFile 'reopens original workbook Application.DisplayAlerts = False ActBook.Close 'closes exported workbook Application.DisplayAlerts = True End If Application.ScreenUpdating = True End Sub 

尝试这样的事情

从这里开始你的错误信息

 '// Here msgbox On Error GoTo ErrMsg ActiveWorkbook.SaveAs FileName:=NewFile, _ FileFormat:=52, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook 'declares variable for open workbook Workbooks.Open CurrentFile 'reopens original workbook Application.DisplayAlerts = False ActBook.Close 'closes exported workbook Application.DisplayAlerts = True End If Application.ScreenUpdating = True 

并确保ErrMsg:在End Sub之前

 '// Here Err MsgBox ErrMsg: MsgBox ("Type your message here."), , "MESSAGE TITLE" End Sub