Option Compare Database

 

' API declared to find the current computer name.

Public Declare Function GetComputerName Lib "kernel32" Alias _

"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

 

Public Project_Choice As String

 

 

Public objDB As DAO.Database

 

 

Function DELETE_TBL003_RECORDS()

Dim ssql As String

ssql = "DELETE * FROM TBL003 where (TBL003.Action = 'DELETE')"

CurrentDb.Execute (ssql)

End Function

 

 

Function DELETE_TBL001_RECORDS()

Dim ssql As String

ssql = "DELETE * FROM TBL001"

CurrentDb.Execute (ssql)

End Function

 

Function VERSION_CHECK()

 

Dim ssql As String

Dim objRS1 As Recordset

Dim VD As String

Dim APIVERSION As Double

 

APIVERSION = 1  'Version of THIS API

 

ssql = "SELECT * from API_VERSIONS"

Set objRS1 = CurrentDb.OpenRecordset(ssql)

objRS1.MoveLast

 

 

If objRS1.Fields("Version_Number") > APIVERSION Then GoTo outofdate

 

objRS1.Close

Exit Function

outofdate:

MsgBox ("This API version is out of date. Please download the latest version")

Call EventLog(2, "NA") 'user notified out of date

objRS1.Close

 

 

End Function

 

Function EventLog(evnt As Integer, ProjectNo As String)

Dim ssql, eventdata As String

 

Select Case evnt

 

Case 1

eventdata = "User Logged into API"

Case 2

eventdata = "User alerted that API was out of date"

Case 3

eventdata = "User ran project configuration"

Case 4

eventdata = "User opened Journal data"

Case 5

eventdata = "User closed Journal data"

Case 6

eventdata = "User Set New Project"

Case 7

eventdata = "User opened recall"

Case 8

eventdata = "User closed recall"

Case 9

eventdata = "User closed API"

Case 10

eventdata = "User encountered error xxxx"

Case 11

eventdata = "User completed download for project " & ProjectNo

Case 12

eventdata = "Download Completed"

Case 13

eventdata = "Upload Completed"

Case 14

eventdata = "Local Tables Cleared"

 

End Select

 

ssql = "INSERT INTO API_EVENT_LOG ( Event, System_ID )SELECT '" & eventdata & "' AS Event, '" & ComputerName_FX() & "' AS [System-ID];"

 

CurrentDb.Execute (ssql)

 

 

End Function

 

 

Public Function ComputerName_FX() As String

 

' Function calls the API function and returns a string of the computer name.

On Error Resume Next

Dim lSize As Long

Dim lpstrBuffer As String

lSize = 255

lpstrBuffer = Space$(lSize)

If GetComputerName(lpstrBuffer, lSize) Then

  ComputerName_FX = Left$(lpstrBuffer, lSize)

Else

  ComputerName_FX = ""

End If

 

End Function

 

Function Open_Project_Configuration()

 

Call EventLog(3, "NA")  ' user opened event configuration

 

Call Upload

Call Clear_Local_Tables

 

End Function

 

Function Close_Project_Configuation()

Call Download

DoCmd.Close acForm, "FRM006"

End Function

 

Function Download()

 

'this is the download for an in progress project

 

'event log

Dim ssql As String

Dim objRS1 As Recordset

ssql = "SELECT * from TBL001" ' select eveything from the configuration table

Set objRS1 = CurrentDb.OpenRecordset(ssql)

Call EventLog(11, objRS1.Fields("Project_Choice"))

'set projectchoice for use in form filtering

 

Project_Choice = objRS1.Fields("Project_Choice") ' public variable

objRS1.Close

 

 

'suppress alerts

DoCmd.SetWarnings (warningsoff)

 

'Download TBL003

DoCmd.OpenQuery ("QRY022")

'Download TBL005

DoCmd.OpenQuery ("QRY023")

'Delete All from SPJournals not posted

DoCmd.OpenQuery ("QRY018")

'Reverse entries that have been posted

DoCmd.OpenQuery ("QRY019")

 

Call EventLog(12, "NA") 'download complete

 

'suppress alerts

DoCmd.SetWarnings (warningson)

 

End Function

 

 

Function Upload()

 

'suppress alerts

DoCmd.SetWarnings (warningsoff)

 

'Upload Journal QRY017

DoCmd.OpenQuery ("QRY017")

 

'Upload TBL003

DoCmd.OpenQuery ("QRY006")

 

'Upload TBL005

DoCmd.OpenQuery ("QRY007")

 

Call Clear_Local_Tables

 

'suppress alerts

DoCmd.SetWarnings (warningson)

 

Call EventLog(13, "NA") ' upload complete

 

End Function

 

 

Function Clear_Local_Tables()

 

'suppress alerts

DoCmd.SetWarnings (warningsoff)

 

'Clear TBL003

DoCmd.OpenQuery ("QRY004")

 

'Clear TBL005

DoCmd.OpenQuery ("QRY008")

 

Call EventLog(14, "NA") ' local tables cleared

 

'suppress alerts

DoCmd.SetWarnings (warningson)

 

End Function

 

Function Recall_Journal()

 

'suppress alerts

DoCmd.SetWarnings (warningsoff)

 

'upload

Call Upload

'clear tables

Call Clear_Local_Tables

'collect data & populate

Call Download

'launch edit form

DoCmd.OpenForm ("FRM004") 'Edit Journal

 

Call EventLog(7, "NA") ' recall Complete

 

'suppress alerts

DoCmd.SetWarnings (warningson)

 

End Function

 

Function Open_Edit_Journal()

 

End Function

 

 

Function Close_Edit_Journal()

 

End Function

 

Function BeforeAPIClose()

Call Upload

Call EventLog(9, "NA")

Application.CloseCurrentDatabase

DoCmd.CloseDatabase

End Function

 

 

Function Close_Select_Project()

 

DoCmd.Close acForm, "FRM001"

DoCmd.SetWarnings (warningsoff)

DoCmd.OpenQuery ("QRY004")

DoCmd.OpenQuery ("QRY003")

DoCmd.SetWarnings (warningson)

 

 

    Form_FRM005.Enter_Info.SetFocus

Form_FRM005.Config_Settings.Visible = False

Form_FRM005.Command14.Visible = True

Form_FRM005.NewProject.Visible = True


 

End Function

 

 

Function New_Month()

 

Form_FRM005.Config_Settings.Visible = True

Form_FRM005.Command14.Visible = False

Form_FRM005.NewProject.Visible = False

 

End Function

Select all