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
我的 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