Attribute VB_Name = "AccessDBHandler"
Public cn As Object, FieldList(), FieldCount, SR

Sub CloseDB()
cn.Close
Set cn = Nothing
End Sub

Sub OpenDB()
Path = "C:\Users\davidge\Documents\CDF Process\New System\Database"
SR = Path
ThisDB = Path & "\CDF_Data DB.accdb"

//Provider=Microsoft.ACE.OLEDB.16.0;Data Source={0};Extended Properties='Excel 12.0 Xml;HDR=Yes';" Set cn = CreateObject("ADODB.Connection") 'C:\Users\p751993\Documents
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & ThisDB '& ";Persist Security Info=False;Mode=Share Exclusive" stops other users
cn.Open sconnect
End Sub

Function GetData(strSQL)
Dim a(0, 0)
'works with a select query to the DB then re-orders and returns data
Dim rs As New ADODB.Recordset
Dim TT()
GetData = a
rs.Open strSQL, cn
If rs.EOF Then Exit Function
Xdata = rs.GetRows
Xcols = UBound(Xdata)
Xrows = UBound(Xdata, 2)
ReDim TT(Xrows + 1, Xcols)
For rdx = 0 To Xrows
For cdx = 0 To Xcols
TT(rdx + 1, cdx) = Xdata(cdx, rdx)
Next cdx
Next rdx

With rs
For cdx = 0 To .Fields.Count - 1
TT(0, cdx) = .Fields(cdx).Name
Next cdx

End With

GetData = TT
rs.Close
End Function

Sub DoSQL(strSQL)

cn.Execute strSQL
CloseDB
End Sub

Function MSDateToSQL(Adate) As String
'SQL Recognises a string "YYYY-MM_DD" as a date
SQ = Chr(39)
MSDateToSQL = SQ & Format(Adate, "YYYY-mm-dd") & SQ
End Function

Sub AddNewRecord(NewData, XTable, rdx)
Dim rs As New ADODB.Recordset
'MsgBox "cannot add new Record"
'Exit Sub
OpenDB
ColRef = XTable & ".ID"
strSQL = "Select MAX(" & ColRef & ") FROM " & XTable & ";"
ThisWorkbook.Sheets("Start").Range("a30") = strSQL
Set rs = cn.Execute(strSQL)
X_ID = rs.Fields(0)
rs.Close
strSQL = "Select * FROM " & XTable & " WHERE ID = " & X_ID

rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic
rs.AddNew
For idx = 2 To UBound(NewData, 2)
rs(idx - 1) = NewData(rdx, idx)
Next idx
rs.Update
rs.Close
CloseDB
End Sub

Sub DataFromDB(DBTable)
strSQL = "SELECT * FROM " & DBTable & ";"
OpenDB
CurrentDData = GetData(strSQL)

CloseDB
End Sub

Sub UpdateRecord(NewDData, DBTable, rx)
Dim rs As New ADODB.Recordset
X_ID = NewDData(rx, 1)

strSQL = "Select * FROM " & DBTable & " WHERE ID = " & X_ID & " ;"
OpenDB
rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic

For idx = 2 To UBound(NewDData, 2)
rs(idx - 1) = NewDData(rx, idx)
Next idx
rs.Update
rs.Close
CloseDB
End Sub