连续循环的 VBScript 需要对错误更健壮

Question

我正在编写一个程序来打开服务器上的运行多个 VBA 模块，以将新数据上传到云端。我需要至少每 5 分钟（最好每 2 分钟）运行模块，而不要长时间 24/7 停止。到目前为止，我的代码可以运行 1000-4000 个循环，但每 1-4 天就会失败一次。如何让我的程序更健壮？

我是 VBScript 的新手，但是从我通过研究发现的其他示例中拼凑了一些运行良好的代码。我添加了一些错误处理（On Error Resume Next 和每次主要操作后的错误检查），但仍然偶尔会出现错误并停止程序。

我看到的错误包括 "unknown VBA runtime error," 权限错误（打开本地日志时）和服务器错误。我试图通过 ping 和错误处理来减轻或忽略这些问题，但有些人仍然设法阻止代码循环。

我也尝试过使用 Windows 任务计划程序，但最多只能每 5 分钟执行一次，我无法可靠地达到运行。

On Error Resume Next

Set WshShell = CreateObject("WScript.Shell")
Dim objFSO
Dim myLog
Dim myLocalLog
Dim pingResultV
Dim pingResultN

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
objExcel.Visible = True
Set myLog = objFSO.OpenTextFile("location of log on server", 8)
Set myLocalLog = objFSO.OpenTextFile("location of log on local hard drive", 8)

Dim i
i = 0
Do While i < 1000000
  'Ping the server to check if the connection is open
  PINGFlagV = Not CBool(WshShell.run("ping -n 1 server",0,True))
  pingResultV = "Null"

  'if the ping was successful, open each file in sequence and run the VBA modules
  If PINGFlagV = True Then
    timeStamp = Now()

    Set Wb = objExcel.WorkBooks.Open("excel file on server",,True)
    objExcel.Application.Run "VBA module to copy data to cloud"
    objExcel.Application.Quit
    If Err.Number <> 0 Then
      myLocalLog.WriteLine(timeStamp & " Error in running VBA Script: " & Err.Description)
      Err.Clear
    End If

    Set Wb2 = objExcel.WorkBooks.Open("second excel file on server",,True)
    objExcel.Application.Run "VBA module to copy this data to cloud"
    objExcel.Application.Quit
    If Err.Number <> 0 Then
      myLocalLog.WriteLine(timeStamp & " Error in running VBA Script 2: " & Err.Description)
      Err.Clear
    End If

    'Write to the server log that it succeeded or failed
    pingResultV = "Server Ping Success"
    myLog.WriteLine(timeStamp & " i=" & i & " --- " & pingResultV)
  Else
    pingResultV = "Server Ping Failed"
    timeStamp = Now()
  End If

  'Write to a local log whether the server was available or not
  myLocalLog.WriteLine(timeStamp & " i=" & i & " --- " & pingResultV)
  If Err.Number <> 0 Then
    myLog.WriteLine(timeStamp & " Error in writing to local log: " & Err.Description)
    Err.Clear
  End If

  'Time between iterations in milliseconds. 120000 ms = 2 minutes
  WScript.Sleep(30000)
  i = i + 1
Loop

我并不是要请人修改我的代码，但我将不胜感激任何改进建议。如果 VBScript 以外的方法更健壮，我也愿意使用它们。

系统的一些其他背景知识可能会有所帮助：我有 2 台计算机每隔几分钟就会将数据上传到服务器，但出于安全原因，这些计算机无法连接到互联网。我需要每隔几分钟将这些计算机生成的数据上传到互联网数据库，以便可以远程访问。我在连接到服务器和互联网的单独计算机上编写的代码运行s，它会定期以只读模式打开服务器上的 excel 文件，并且运行s a VBA 上传新数据线到云端的脚本。

Answer 1

很难判断是您的 VBScript 还是 VBA 模块或两者都失败了。从您的错误描述来看，我有点希望是后者。因此，我还建议（再次）检查您的 VBA 尾声。至于这个脚本，我建议摆脱权限/日志文件错误的一件事是将日志记录移动到它自己的方法，例如

' *** VBScript (FSO) ***
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

' Log file
Const LOG_FILE = "C:\MyData\MyLog.txt"

Sub WriteLog (ByVal sLogFile, ByVal sText)
    Dim oFso
    Dim oLogFile

    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oLogFile = oFso.OpenTextFile(sLogFile, ForAppending, True)

    ' Prefix log message with current date/time
    sText = Now & " " & sText
    oLogFile.WriteLine sText
    oLogFile.Close

    ' Free resources
    Set oLogFile = Nothing
    Set oFso = Nothing

End Sub

然后这样称呼它

If Err.Number <> 0 Then
    WriteLog LOG_FILE, "Error in writing to local log: " & CStr(Err.Number) & ", " & Err.Description
    Err.Clear
End If

我还建议在循环结束时释放所有资源，例如Excel 对象，为此您需要将对象创建移动到循环中：

Dim i
i = 0
Do While i < 1000000

    ' Start of loop
    Set objExcel = CreateObject("Excel.Application")
    objExcel.DisplayAlerts = False
    objExcel.Visible = True

    ' Do your stuff ...

    ' End of Loop -> free resources
    Set Wb = Nothing
    Set Wb2 = Nothing
    objExcel.WorkBooks.Close
    Set objExcel = Nothing

    ' Time between iterations in milliseconds. 120000 ms = 2 minutes
    WScript.Sleep(30000)
    i = i + 1
Loop

由于我不是 Excel 专家，我想知道 objExcel.Visible = True 在这里是否有意义，或者是否最好设置为 False？

连续循环的 VBScript 需要对错误更健壮

Continuously looping VBScript needs to be more robust to errors

vbscript