VBScript "open all workbooks" 错误处理

VBScript "open all workbooks" Error Handling

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

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

我需要为这种情况构建一个错误处理程序,这样已经打开的文件就会被跳过,循环将继续不间断。不幸的是,DisplayAlerts = False 好样的 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

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