I am pretty deep into building a very multi-faceted little app in Excel with VBA. It does a number of tasks, all centered around using OPC to get tag values from several PLC's and doing various things with the info, like publishing a webpage (using a module I found, not mine), creating log files and tables and sounding some audible alarms for the office.
What I'm doing now is, upon a button push, connecting to the server (RSLinx), then entering a loop that first reads the tag values, then does each of the above tasks if the associated checkbox is checked. This will run fine indefinitely so long as the user doesn't screw with it or Linx or let the computer lock.
I am a beginner coder so, please give me some feedback on the code itself, but what I'm really trying to do is make this bulletproof, so that it will run without fail. I've added some things like on a selectionchange event, if you're connected, give a messagebox that says not to make changes while running. But, I know this can be much better.
Also, I already know this might be done better in various other ways, but this is a little beginner pet project for me and I'm going to see it through before I move on. All criticism is welcome.
Option Explicit ' variables must be declared
Option Base 1 ' array starts at index 1
'Dim OPCServer1 As OPCServer
Dim WithEvents OPCGroup1 As OPCGroup
Dim MyOPCItems() As OPCItem
Dim NumberOfTags As Integer
Dim ReadInterval As Double
Sub OPC_Connect()
debugEvent "OPC - OPC_Connect()"
status_update ("Connecting...")
On Error GoTo Error_OpcConnectionFailure
Dim GrpName As String
Dim i As Integer
Dim g As Integer
Dim h As Integer
Dim row_tag_name As String
For h = 1 To 7
Module1.SavedThisTime(h) = False
Next h
ThisWorkbook.connected = True
GrpName = Cells(5, 2)
'NumberOfTags = Cells(6, 2)
NumberOfTags = 0
status_update ("Adding Tags...")
For g = 1 To 10000
If Not IsEmpty(Cells(4 + g, 4).value) Then
NumberOfTags = NumberOfTags + 1
End If
Next g
If Not ThisWorkbook.OPCServer1 Is Nothing Then 'safety
Exit Sub
End If
Set ThisWorkbook.OPCServer1 = New OPCServer
Call ThisWorkbook.OPCServer1.Connect(Cells(4, 2)) 'connect to the OPC Server
Set OPCGroup1 = ThisWorkbook.OPCServer1.OPCGroups.Add(GrpName) 'add the group
'add the 6 items
ReDim MyOPCItems(NumberOfTags)
For i = 1 To NumberOfTags
On Error GoTo Error_TagNotFound
If Cells(4 + i, 6) = 1 Then
row_tag_name = Cells(4 + i, 4) & "." & Cells(4 + i, 5) & ",L1,C1"
Set MyOPCItems(i) = OPCGroup1.OPCItems.AddItem(Cells(4 + i, 4) & "." & Cells(4 + i, 5) & ",L1,C1", i)
Else
row_tag_name = Cells(4 + i, 4) & ",L1,C1"
Set MyOPCItems(i) = OPCGroup1.OPCItems.AddItem(Cells(4 + i, 4) & ",L1,C1", i)
End If
Next i
status_update ("Connected")
ThisWorkbook.LoggedThisTime = False
Time_Delay (1)
Exit Sub
'Debug.Print "OPCServer1 is " & OPCServer1 & " at end of Connect sub"
Error_OpcConnectionFailure:
OPC_Disconnect
MsgBox ("Connection Failed:" & vbNewLine & vbNewLine & "Check Your server name and ensure RSLinx is Running.")
Exit Sub
Error_TagNotFound:
OPC_Disconnect
MsgBox ("Connection Failed. Check tag: " & vbNewLine & vbNewLine & row_tag_name)
Exit Sub
End Sub
Sub OPC_Disconnect()
ThisWorkbook.connected = False
debugEvent "OPC - OPC_Disconnect()"
On Error Resume Next
If ThisWorkbook.OPCServer1 Is Nothing Then
Exit Sub
End If
Call ThisWorkbook.OPCServer1.OPCGroups.RemoveAll 'free all the items and groups
Call ThisWorkbook.OPCServer1.Disconnect 'disconnect from the OPC Server
Set ThisWorkbook.OPCServer1 = Nothing
ThisWorkbook.OPC_StopReadLoop = True
status_update ("Not Connected")
End Sub
Sub OPC_RefreshServer()
debugEvent "OPC - OPC_RefreshServer()"
OPC_Disconnect
Time_Delay (1)
OPC_Connect
End Sub
Sub OPC_Read()
debugEvent "OPC - OPC_Read()"
status_update ("Reading Tags...")
On Error GoTo Error_TagRead
Dim Temp_Buffer1
Dim ServerHandles() As Long
ReDim ServerHandles(NumberOfTags) 'item ID (server side)
Dim Values() As Variant 'return values
Dim Errors() As Long
'these next two are different. They are variant arrays, not arrays of type variant. A variant that is an array of a type.
Dim Qual As Variant 'not using but must provide for function call
Dim TimeValue As Variant
Dim i As Integer
If ThisWorkbook.OPCServer1 Is Nothing Then 'safety
If Sheets("Setup").AutoReconnect_ChkBx.value = True Then
OPC_RefreshServer
Else
Exit Sub
End If
End If
If Not (ThisWorkbook.OPCServer1.ServerState = OPCServerState.OPCRunning) Then 'safety
Exit Sub
End If
'set up which items to be read
For i = 1 To NumberOfTags
ServerHandles(i) = MyOPCItems(i).ServerHandle
Next i
Call OPCGroup1.SyncRead(OPCCache, NumberOfTags, ServerHandles, Values, Errors, Qual, TimeValue)
'put the value and time stamp in cells
For i = 1 To NumberOfTags
Cells(4 + i, 3) = Values(i)
' Cells(4 + i, 2) = TimeValue(i)
Next i
'free the memory
Erase Values()
Erase Errors()
Exit Sub
Error_TagRead:
OPC_Disconnect
MsgBox ("Tag Read Error." & vbNewLine & "Please reconnect to server.")
Exit Sub
End Sub
Sub OPC_Write()
debugEvent "OPC - OPC_Write()"
Dim ServerHandles(6) As Long 'item ID (server side)
Dim Values(6) As Variant 'values
Dim Errors() As Long
Dim i As Integer
If ThisWorkbook.OPCServer1 Is Nothing Then 'safety
Exit Sub
End If
If Not (ThisWorkbook.OPCServer1.ServerState = OPCServerState.OPCRunning) Then 'safety
Exit Sub
End If
'set up which items to be write
For i = 1 To 6
ServerHandles(i) = MyOPCItems(i).ServerHandle
Next i
'fetch the values from the cells
For i = 1 To 6
Values(i) = Cells(8 + i, 3)
If Values(i) = "" Then
Values(i) = 0
End If
Next i
Call OPCGroup1.SyncWrite(6, ServerHandles, Values, Errors)
End Sub
Sub ReadBtn_Click()
debugEvent "OPC - ReadBtn_Click()"
OPC_Read
End Sub
Sub OPC_LoopRead()
debugEvent "OPC - OPC_LoopRead()"
On Error GoTo Error_Reconnect
ReadInterval = Sheets("Setup").Range("C15")
ThisWorkbook.enable_audible_alarm = False
Module1.logged_this_time = False
Do While ThisWorkbook.OPC_StopReadLoop = False
Application.Cursor = XlMousePointer.xlDefault
status_update ("Reading Tags")
OPC_Read
status_update ("In Time Delay")
If Not ThisWorkbook.OPCServer1 Is Nothing Then 'safety
Time_Delay (ReadInterval)
If Sheets("Setup").audible_alarms_enable_ChkBx.value = True Then
status_update ("Sounding Alarms")
Sheets("Audible Alarms").LoopAudibleAlarms
status_update ("Done Sounding Alarms")
End If
If Sheets("Setup").NewLogRow_ChkBx.value = True Then
Sheets("Setup").NewLogRow_OnInterval
End If
If Sheets("Setup").website_publish_enable_ChkBx.value = True Then
status_update ("Publishing")
Publish
status_update ("Done Publishing")
End If
If Sheets("Setup").LogData_ChkBx.value = True Then
status_update ("Saving Log File")
LogData
status_update ("Done Saving Log File")
End If
End If
Loop
ThisWorkbook.OPC_StopReadLoop = False
Exit Sub
Error_Reconnect:
If ThisWorkbook.OPCServer1 Is Nothing Then 'safety
If Sheets("Setup").AutoReconnect_ChkBx.value = True Then
OPC_RefreshServer
Else
Exit Sub
End If
End If
End Sub
Private Sub OPC_ConnectBtn_Click()
debugEvent "OPC - OPC_ConnectBtn_Click()"
OPC_Connect
OPC_LoopRead
End Sub
Sub OPC_DisconnectBtn_Click()
debugEvent "OPC - OPC_DisconnectBtn_Click"
OPC_Disconnect
End Sub
Sub OPC_Read_Once_Btn_Click()
debugEvent "OPC - OPC_Read_Once_Btn_Click()"
OPC_ReadOnce
End Sub
Sub status_update(status As String)
debugEvent "OPC - status_update(" & status & ")"
Cells(8, 2) = status
End Sub
Sub OPC_ReadOnce()
debugEvent "OPC - OPC_ReadOnce()"
OPC_Connect
OPC_Read
Time_Delay (1)
OPC_Disconnect
status_update ("Updated Tag Values Successfully")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'User input for time interval for main loop
If (Not Intersect(Target, Range("C5:G65000")) Is Nothing) Or _
(Not Intersect(Target, Range("A4:B8")) Is Nothing) Then
If ThisWorkbook.connected = True Then
MsgBox ("Please disconnect before changing any settings.")
Exit Sub
End If
End If
End Sub