Error handling VBScript"；“打开所有工作簿”；错误处理

My

VBScript

打开文件夹中的所有“xlsm”文件，运行

VBA

code“Slim”并关闭工作簿（逐个）。它工作得很好，但我很难处理错误。如果脚本试图打开当前由其他人打开的工作簿，则会出现错误弹出窗口

其他人正在/path+wb name/中工作。请稍后再试。

循环将暂停，直到单击警告消息上的

OK

。看起来它会毫无问题地打开工作簿，但最后会出现错误，因为VBA代码会保存一个新文件并尝试删除旧文件。因此，我将在错误消息的顶部创建一个新文件和一个未删除的旧文件

虽然显然不是理想的解决方案，但在这种情况下退出整个循环也比等待单击OK要好，因为VBScript是自动启动的

我需要为这个场景构建一个错误处理，这样已经打开的文件就会被跳过，循环将不间断地继续。不幸的是，在错误恢复下一步时，

DisplayAlerts=False

good-ol'

无法在此处执行此操作

如果可能的话，我希望通过VBScript解决这个问题，而不是调整VBA代码

Set fso = CreateObject("Scripting.FileSystemObject")
Set xl  = CreateObject("Excel.Application")

On Error Resume Next
xl.DisplayAlerts = False

For Each f In fso.GetFolder("G:\Archive").Files
  If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
    
    Set wb = xl.Workbooks.Open(f.Path)
    
    xl.Run "Slim"    
    wb.Close

  End If

Next

xl.Quit

Set fso = Nothing
Set xl = Nothing

尝试了不同的场景，到目前为止还没有破解。最新的选项是此选项，但没有帮助（是否有其他方法检查工作簿当前是否为只读）

如果excel文件已打开，则会阻止再次打开该文件。重命名文件也被阻止，但重命名失败不会显示带有
resume next

试试这个代码。它首先尝试重命名文件。如果重命名成功，它将重新命名，然后运行宏。如果重命名失败，它将跳过该文件

Set fso = CreateObject("Scripting.FileSystemObject")
Set xl  = CreateObject("Excel.Application")

On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("D:\MikeStuff\StackOverflow\ExcelCheckOpen").Files
  If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
    xpath = f.Path  ' file path lost after rename
    fso.MoveFile xpath, xpath & ".txt"  ' will fail if file locked by excel
    if fso.FileExists(xpath & ".txt") Then ' rename worked, file not locked
        fso.MoveFile xpath & ".txt", xpath  ' rename back
        Set wb = xl.Workbooks.Open(xpath)
        xl.Run "Slim"    
        wb.Close
    End If
  End If
Next

xl.Quit

Set fso = Nothing
Set xl = Nothing

谢谢你的回复！看起来是个不错的方法。不过，我认为代码的后半部分需要一些调整。首先，我认为嵌套If语句缺少一端If（否则将报告“下一个意外”错误）。但还有一些事情我不能马上解决。如果在wb.Close之后添加一个End If，则代码将运行，但它只会以重命名的文件结束，例如，看起来像是重命名back+工作簿Open+xl.run将不会运行（尽管当前打开的文件未重命名-因此主If检查有效）。抱歉-我键入了错误<如果添加了

，则代码>结束。对于另一个问题，如果重命名成功，则应将文件重命名回原始名称。您是否看到具有不同名称的重复文件？不，保留.txt扩展名，例如，也没有重复文件。很确定嵌套IF根本没有启动——它几乎会在一眨眼之间运行，所以看起来打开的工作簿甚至没有被附加。在末尾添加了一个消息框WScript.Echo以标记脚本的结尾。这也显示没有问题，因此每个周期的输入都会通过。另一个输入错误。应该是

f.Path

。请重试。我想是的。请重试。

Set fso = CreateObject("Scripting.FileSystemObject")
Set xl  = CreateObject("Excel.Application")

On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("D:\MikeStuff\StackOverflow\ExcelCheckOpen").Files
  If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
    xpath = f.Path  ' file path lost after rename
    fso.MoveFile xpath, xpath & ".txt"  ' will fail if file locked by excel
    if fso.FileExists(xpath & ".txt") Then ' rename worked, file not locked
        fso.MoveFile xpath & ".txt", xpath  ' rename back
        Set wb = xl.Workbooks.Open(xpath)
        xl.Run "Slim"    
        wb.Close
    End If
  End If
Next

xl.Quit

Set fso = Nothing
Set xl = Nothing