在语音模块嵌入了半年左右的时间，经过实际使用发现，代码冗余，重复太多，维护较难，新增也不易，故而对整个框架进行整理，实现简单添加，维护容易的目的。

1.代码优化

1.1构建自定义过程

name 参数代表设备名

tt代表要打开的画面名（故障画面/报警画面）

sqll代表要存入数据库的内容（故障/报警）

Public Sub Sound(ByVal name As String, ByVal tt As String, ByVal sql As String)
On Error Resume Next
Dim workspace As Object
Set workspace = GetObject("", "Workspace.Application")
Dim tagvar As Object
Set tagvar = workspace.Documents("User").Page.FindObject("PicNumBer")
tagvar.Description = nameDim TOP As Integer
Dim LEFT As Integer
TOP = Int((50 * Rnd) + 1)
LEFT = Int((50 * Rnd) + 1)Dim StrD As String
Dim userid As String
Dim username As String
Dim groupname As String
System.FixGetUserInfo userid, username, groupname
StrD = Format(Now, "yyyy-mm-dd hh:mm:ss")
Set conODBC = New ADODB.Connection
conODBC.ConnectionString = "DSN=QPWS;UID=sa;PWD=;"
conODBC.Open "QPWS", "sa", ""
conODBC.Execute "insert into kaitingshijian(DateTimee,mingcheng,neirong,operator) values ('" + StrD + "','" + name + "', '" + sql + "', '" + username + "')"
conODBC.Close
openpicture tt, "", TOP, LEFT, 0, , NONE, "", True
End Sub

1.2 调度内容重构

直接使用关键字Call 自定义过程名的方法来使用。

Private Sub FixEvent1_WhileTrue()Call Sound("二期粗格栅1号污水泵", "故障报警.grf", "故障")End Sub

2.细节优化

2.1调度后台被关闭时，自动打开

由于本系统依赖于后台事件调度，故而保持fixbackground.exe后台的运行很关键。

编写函数（摘抄于网上大神）

Public Function CheckExeIsRun(exeName As String) As BooleanOn Error GoTo ErrDim WMIDim ObjDim ObjsCheckExeIsRun = FalseSet WMI = GetObject("WinMgmts:")Set Objs = WMI.InstancesOf("Win32_Process")For Each Obj In ObjsIf (InStr(UCase(exeName), UCase(Obj.Description)) <> 0) ThenCheckExeIsRun = TrueIf Not Objs Is Nothing Then Set Objs = NothingIf Not WMI Is Nothing Then Set WMI = NothingExit FunctionEnd IfNextIf Not Objs Is Nothing Then Set Objs = NothingIf Not WMI Is Nothing Then Set WMI = NothingExit Function
Err:If Not Objs Is Nothing Then Set Objs = NothingIf Not WMI Is Nothing Then Set WMI = Nothing
End Function

2.2函数调用

关于函数调用，这要用到定时器插件。再看你的画面中一直保持不变的东西，比如标题栏，然后将定时器放置在标题栏中，并编写调用函数

Private Sub diaodu1_OnTimeOut(ByVal lTimerId As Long)If CheckExeIsRun("FIXBACKGROUNDSERVER.EXE") = False ThenShell System.FixPath(Base_Path) & "\FIXBACKGROUNDSERVER.EXE"End If
End Sub

3.备注补充

有些可能遇到另外一种特殊情况：就是报“自动化错误”弹窗，而且不点开fixbackground后台框，无法发现。这样在无法找到原因的情况下，有一个权宜之计-使用定时器，定时关闭fixbackground后台。（每天之行一次：24:00:02）

Private Sub killdiaodu_OnTimeOut(ByVal lTimerId As Long)
If CheckExeIsRun("FIXBACKGROUNDSERVER.EXE") = True Then
Shell System.FixPath(Base_Path) & "\diaodu.bat"
End If
End Sub

diaodu.bat

@echo off
taskkill /im FixBackgroundServer.exe /f
EXIT

至此，一个完整的语音报警系统模块，可以投入正式的生产使用之中。