VBScript“打开所有工作簿”错误处理

Question

我的VBScript 打开文件夹中的所有“xlsm”文件，运行VBA 代码“Slim”并关闭工作簿（一个接一个）。它工作正常，但我很难处理错误。如果脚本试图打开当前由其他人打开的工作簿，我最终会弹出错误Someone else is working in /path + wb-name/ right now. Please try again later. 并且循环暂停直到在警告消息上单击OK。看起来它可以毫无问题地打开工作簿，但最后会出现错误，因为 VBA 代码会保存一个新文件并尝试删除旧文件。因此，我将在错误消息的顶部得到一个新文件和未删除的旧文件。

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

我需要为这种情况构建一个错误处理，这样已经打开的文件将被跳过，循环将继续不间断。不幸的是，DisplayAlerts = Falsegood ol' On Error Resume Next 不会在这里做。

如果可能以合理的方式，我想通过 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

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

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

    xl.Run "Slim"
    wb.Close

    Else

    wb.Close

    End If
        
  End If

Next

Answer 1

如果 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