Question

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

下面的代码为当前工作簿执行SaveAs，允许用户选择名称，关闭新保存的文件并重新打开原始文件。这适用于服务器上许多用户的Excel工作簿，许多人将不断打开/关闭文件。

问题是，当用户尝试执行下面的代码以保存另一个用户已打开的文件时，程序会显示运行时错误“1004”：您无法将此工作簿保存为与另一个打开的同名工作簿或加载项等。

有没有人知道如何检查SaveAs目的地是否已经打开，然后显示MsgBox“文件被其他用户打开。请等到他们关闭或选择其他文件名。”< / p>

任何帮助都会非常感激，无法想出这个！

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

Answer 1

尝试这样的事情

从这里开始你的错误消息

'// 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

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

1 个答案: