19. september 2002 - 11:53
#3
Der er ingen events som peger på AutoExec. Det eneste AutoExec gør et at den kalder en function Startup som kalder en Sub som kalder en anden Sub.
'********************************************************************************************
'This function is called from the function Startup and makes a raw copy of the content of the
'Journalfile into the JourInfoLink.
'
'ver. 001 RMun 2002-09-04
'********************************************************************************************
Public Sub OpenFile()
On Error GoTo ErrHandler
'Declaration of variables
Dim strSQL As String
DoCmd.Hourglass True
DoCmd.SetWarnings False
'Delete existing table JourInfoLink
DoCmd.DeleteObject acTable, "JourInfoLink"
'Makes a linked table - JourInfoLink - to the journalfile
DoCmd.TransferText acLinkFixed, "Jouinfo Link Specification", "JourInfoLink", cStrPath
strSQL = "SELECT JourInfoLink.* INTO JournalInfo FROM JourInfoLink;"
'Transfers all data from the table JourInfoLink to the table JournalInfo
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'Calls the procedure SearchJournalInfo
SearhJournalInfo
DoCmd.Hourglass False
Exit Sub
ErrHandler:
MsgBox Err.Description
Exit Sub
End Sub
'********************************************************************************************
'This procedure is called from the function Openfile. It runs through the journalfile and
'fetches all relevant information.
'
'ver. 001 RMun 2002-09-04
'********************************************************************************************
Public Sub SearhJournalInfo()
On Error GoTo ErrHandler
'Declaration of variables
Dim con As ADODB.Connection
Dim rstJournalInfo As ADODB.Recordset
Dim rstTagData As ADODB.Recordset
Dim strOccuranceTime As String
Dim strTagName As String
Dim strSQL As String
Set rstJournalInfo = New ADODB.Recordset
Set rstTagData = New ADODB.Recordset
Set con = New ADODB.Connection
'Indicates the name of the provider for the con object
con.Provider = "Microsoft.Jet.OLEDB.4.0"
'Opens the connection
con.Open CurrentDb.Name, "admin", ""
DoCmd.SetWarnings False
strSQL = "DELETE TagData.* FROM TagData;"
'Empties the table TagData
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'Makes a recordset based on the table JournalInfo
rstJournalInfo.Open "JournalInfo", con, adOpenKeyset, adLockOptimistic
'Makes another recordset based on the empty table TabData
rstTagData.Open "TagData", con, adOpenKeyset, adLockOptimistic, adCmdTable
'Run through the table JournalInfo untill the string "Occurancetime:" is met
Do Until Left(rstJournalInfo!Field1, 14) = "OccuranceTime:"
rstJournalInfo.MoveNext
Loop
Do Until rstJournalInfo.EOF
If Left(rstJournalInfo!Field1, 14) = "OccuranceTime:" Then
'If "OccuranceTime:" is met store the logTime in strOccuranceTime
strOccuranceTime = Trim$(Right(rstJournalInfo!Field1, 25))
End If
If Left(rstJournalInfo!Field1, 8) = "TagName:" Then
'Add a new record to rstTagData Alias table TagData
rstTagData.AddNew
'If "TagName:" is met store the tagname in strTagName
strTagName = Mid(Trim$(Mid(rstJournalInfo!Field1, 9)), 2)
'Insert TagName and LogTime in table TagData
rstTagData!TagName = Trim$(Mid(strTagName, 1, InStr(1, strTagName, " ")))
rstTagData!LogTime = strOccuranceTime
If strOccuranceTime <> "" Then
'Insert Time in format #DD-MM-YYYY HH:MM:SS# in TagData
rstTagData!Time = Format(CDate(Left(strOccuranceTime, Len(strOccuranceTime) - 4)), "DD-MM-YYYY HH:MM:SS")
End If
End If
'If "ValueSpecification:" is met enter IF Statement
If Left(rstJournalInfo!Field1, 19) = "ValueSpecification:" Then
'Insert Value in table TagData
rstTagData!Value = Trim$(Mid(rstJournalInfo!Field1, 20))
If InStr(1, rstTagData!Value, Chr(34)) <> 0 Then
'If " is present in value cut it of and insert the updated value
rstTagData!Value = Trim$(Mid(rstTagData!Value, InStr(1, rstTagData!Value, Chr(34)) + 1))
End If
If Right(rstTagData!Value, 1) = ")" Then
'If ) is present in value cut it of and insert the updated value
rstTagData!Value = Trim$(Mid(rstTagData!Value, 1, InStr(1, rstTagData!Value, Chr(34)) - 1))
'Row in table TagData is only committed if value is detected
rstTagData.Update
End If
End If
rstJournalInfo.MoveNext
Loop
rstJournalInfo.Close
con.Close
Exit Sub
ErrHandler:
MsgBox Err.Description
Exit Sub
End Sub
'********************************************************************************************
'This function is called from the macro AuteExec which fires when the SattlineSearcher.mde file
'is opened. Furthermore it calls other functions that transfers information from the Sattline
'Journalfile to SattlineSeacher
'
'ver. 001 RMun 2002-09-04
'********************************************************************************************
Public Function Startup()
On Error GoTo ErrHandler
'Declaration of variables
Dim objFs As Object
'Prompts the user to place the Journalfile i c:\ and rename it to journalfile.txt
MsgBox "Place the extractionfile from Sattline in c:\ and rename it to journalfile.txt!", , "SattlineSearcher"
Set objFs = CreateObject("Scripting.FileSystemObject")
If objFs.FileExists(cStrPath) Then
'If the user have applied the requirements in the msgbox the system will call the
'function OpenFile.
MsgBox "After pressing OK SattlineSearcher will analyse the journalfile, " & vbCrLf & _
"which can take som minutes. Please be patient!", , "SattlineSearcher"
OpenFile
DoCmd.OpenForm "frmTextSearch", acNormal, , , , acWindowNormal
DoCmd.Maximize
Form_frmTextSearch.cmdShowAll_Click
Else
'If the user does not do as specified in msgbox, the startup function will call
'itself and the user will be prompted with the same msgbox again. The system will
'keep on doing so untill the requirements in the msgbox are met.
Set objFs = Nothing
Startup
End If
Set objFs = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description
Exit Function
End Function
Som det fremgår kalder Startup også følgende event:
Public Sub cmdShowAll_Click()
On Error GoTo Err_cmdShowAll_Click
'Declaration of variables
Dim strSQL As String
Dim con As ADODB.Connection
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Set con = New ADODB.Connection
'Indicates the name of the provider for the con object
con.Provider = "Microsoft.Jet.OLEDB.4.0"
'Opens the connection
con.Open CurrentDb.Name, "admin", ""
strSQL = "SELECT Min(TagData.Time) AS StartTime, Max(TagData.Time) AS StopTime FROM TagData;"
'Open recordset which holds the first and last logged time in the tabel TagData
rst.Open strSQL, con, adOpenKeyset, adLockOptimistic
DoCmd.Hourglass True
'Update the textboxes
txtStartTime = rst!StartTime
txtStopTime = rst!StopTime
'Set SQL string to specify all tags fra TagData
strSQL = "SELECT DISTINCT TagData.TagName FROM TagData;"
'Update listbox
lstTags.RowSource = strSQL
'Set SQL string to specify all records in the table TagData
strSQL = "SELECT TagData.TagName, TagData.LogTime, TagData.Value, TagData.Time " & _
"FROM TagData WHERE " & _
"(TagData.Time) Between [Forms]![frmTextSearch]![txtStartTime] And " & _
"[Forms]![frmTextSearch]![txtStopTime]" & _
"ORDER BY TagData.TagName, TagData.LogTime;"
'Update listbox
lstSelectedTags.RowSource = strSQL
DoCmd.Hourglass False
rst.Close
con.Close
Exit_cmdShowAll_Click:
Exit Sub
Err_cmdShowAll_Click:
MsgBox Err.Description
Resume Exit_cmdShowAll_Click
End Sub
Jeg kan ikke se hvad årsagen er til at den siger at den ikke kan finde makroen 'SattlineSearcher.' !!!
