Access Frontend Database Creating "Local" Tables Using Visual Basic

This utility started because of a project I was working on, that had several large lookup tables, that were semi-static, that means that they are not changed very often, but they can actually be updated when the user wish to add something. Until this I was using almost always linked tables, but this time the lookup tables were really large and the network as a bit slow. So I started thinking in a way to make this lookup tables local, this would increase performance and reduce network traffic.

Public Function ExportCensusData(FacCode As String)

Dim SQL As String
Dim DB As DAO.Database
Dim RS As DAO.Recordset

Dim TableName As DAO.TableDef
Dim FieldName As DAO.Field
Dim FieldProperty As DAO.Property

Dim Qry As DAO.QueryDef


Dim I As Integer
Dim ResID As Integer
Dim ActionCd As String

'Dim FacCode As String

'FacCode = "Census"



If DoesTblExist("LocCensusTbl") = True Then
    DoCmd.SetWarnings False
    DoCmd.DeleteObject acTable, "LocCensusTbl"
    DoCmd.SetWarnings True
End If

Set DB = CurrentDb()
Set TableName = DB.CreateTableDef("LocCensusTbl")
    
    With TableName
        .Fields.Append .CreateField("Facility_Code", dbText, 5)
        .Fields.Append .CreateField("Client_Id_Number", dbText, 35)
        .Fields.Append .CreateField("Effective_Date", dbDate)
        .Fields.Append .CreateField("Status_code", dbText, 5)
        .Fields.Append .CreateField("Action_code", dbText, 5)
        .Fields.Append .CreateField("Adt_tofrom", dbInteger)
        .Fields.Append .CreateField("Primary_payer_code", dbText, 20)
        .Fields.Append .CreateField("Rugs_code", dbText, 5)
        .Fields.Append .CreateField("Rugs_modifier_code", dbText, 2)
        .Fields.Append .CreateField("Adt_tofrom_loc", dbText, 100)
        .Fields.Append .CreateField("Assess_ref_date", dbDate)
        .Fields.Append .CreateField("Outpatient_status", dbText, 1)
        .Fields.Append .CreateField("Admission_type_code", dbInteger)
        .Fields.Append .CreateField("Admission_source_code", dbInteger)
        .Fields.Append .CreateField("UnitDescription", dbText, 35)
        .Fields.Append .CreateField("FloorDescription", dbText, 50)
        .Fields.Append .CreateField("RoomDescription", dbText, 60)
        .Fields.Append .CreateField("BedDescription", dbText, 30)
        .Fields.Append .CreateField("HospitalStayFrom", dbDate)
        .Fields.Append .CreateField("HospitalStayTo", dbDate)
        .Fields.Append .CreateField("RESIDENT_ID", dbLong)
        .Fields.Append .CreateField("RES_STAY_ID", dbLong)
        .Fields.Append .CreateField("SeqNum", dbInteger)
        .Fields.Append .CreateField("IdNum", dbLong)
    End With
    
    With TableName
        .Fields("Facility_Code").DefaultValue = FacCode
        .Fields("IdNum").Attributes = dbAutoIncrField
        .Fields("UnitDescription").AllowZeroLength = True
        .Fields("FloorDescription").AllowZeroLength = True
        .Fields("RoomDescription").AllowZeroLength = True
        .Fields("BedDescription").AllowZeroLength = True
    End With

DB.TableDefs.Append TableName

Set FieldName = TableName.Fields("Effective_date")
Set FieldProperty = FieldName.CreateProperty("Format", dbText, "mm/dd/yyyy")
FieldName.Properties.Append FieldProperty

Set FieldName = TableName.Fields("Assess_ref_date")
Set FieldProperty = FieldName.CreateProperty("Format", dbText, "mm/dd/yyyy")
FieldName.Properties.Append FieldProperty

End Function

Select allOpen in new window

Public Function DoesTblExist(strTblName As String) As Boolean
    On Error Resume Next
    Dim DB As DAO.Database
    Dim Tbl As DAO.TableDef
    Set DB = CurrentDb
    Set Tbl = DB.TableDefs(strTblName)
    If Err.Number = 3265 Then   ' Item not found.
       DoesTblExist = False
       Exit Function
    End If
    DoesTblExist = True
End Function

Select allOpen in new window