Option Explicit
Public accAP As Access.Application, accDB As Database, accDF As TableDefs
Public daoDE As DAO.DBEngine, daoWS As DAO.Workspace, daoDB As DAO.Database, daoRS As DAO.Recordset, daoTB As DAO.TableDef, daoFD As DAO.Field
Public daoID As DAO.Index, daoIF As DAO.Field
Public shtFMT As Worksheet, lngFMTRow As Long, lngFMTCol As Long, strFMT As String
Public shtMAP As Worksheet, lngMAPRow As Long, lngMAPCol As Long, strMAP As String
Public shtSRC As Worksheet
Public lngSRCRow As Long, lngSRCRowF As Long, lngSRCRowT As Long, lngSRCCol As Long, strSRCCol As String, lngSRCColT As Long
Public wkbNew As Workbook, shtNew As Worksheet, lngNewFile As Long
Public lngLayOutRow As Long, strFieldName As String, varFieldLength As Variant
Public strPath As String, strActiveCell As String
Public strVerN As String, strVersion As String, strValueType As String
Public strMTHS As String, strMTHF As String, strMTHT As String, lngMTHS As Long
Public lngREC1 As Long, lngREC2 As Long
Public strCom1 As String, strCom2 As String, strCom3 As String, strCom4 As String
Public strCom5 As String, strCom6 As String, strCom7 As String, strCom8 As String
Public strTmp1 As String, strTmp2 As String, strTmp3 As String, strTmp4 As String
Public strTmp5 As String, strTmp6 As String, strTmp7 As String, strTmp8 As String
Public strApro As String, strComF As String
Public strFST1 As String, strFST2 As String, strFST3 As String
Public strLST1 As String, strLST2 As String, strLST3 As String
Public varAMT As Variant
Public Sub CreateDB()
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path & "\"
If Dir(strPath & "UploadNew.accdb", vbNormal) <> "" Then
Kill (strPath & "UploadNew.accdb")
End If
Set accAP = Nothing
Set accDB = Nothing
Set accAP = New Access.Application
Set accDB = accAP.DBEngine.CreateDatabase(strPath & "UploadNew.accdb", dbLangGeneral)
accAP.Visible = True
Debug.Print ThisWorkbook.Path & "\" & "uploadNew.accdb"
accDB.Close
accAP.Quit
Set accAP = Nothing
Set accDB = Nothing
Dim AResult As Boolean
AResult = CreateTables("Source", "Summary")
Application.ScreenUpdating = True
End Sub
Public Function CreateTables(shtLayOut As String, strTableName As String) As Boolean ' just test for pass fail with out error
Application.EnableLargeOperationAlert = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path & "\"
Set daoWS = Nothing
Set daoDB = Nothing
Set daoTB = Nothing
Set daoWS = DBEngine.Workspaces(0)
Set daoDB = daoWS.OpenDatabase(strPath & "UploadNew.accdb") ' strDatabase is the full path to the accdb or mdb
Set daoTB = daoDB.CreateTableDef(strTableName) ' you will need to declare daoTB As DAO.TableDef at the top of your procedure
lngLayOutRow = 2
'Do While Len(shtLayOut.Cells(lngLayOutRow, 2))
'strFieldName = shtLayOut.Cells(lngLayOutRow, 6)
'varFieldLength = shtLayOut.Cells(lngLayOutRow, 3)
'If shtLayOut.Cells(lngLayOutRow, 2) = "Text" Then
Set daoFD = daoTB.CreateField("MyTest", dbText, 10) ' fix variable strfieldname - put in a hardcoded value for now
daoFD.Required = False
daoFD.AllowZeroLength = True
'Else
'If shtLayOut.Cells(lngLayOutRow, 2) = "Number" And shtLayOut.Cells(lngLayOutRow, 3) = "Double" Then
'Set daoFD = daoTB.CreateField(strFieldName, dbDouble)
'daoFD.Required = False
'daoFD.DefaultValue = 0
'Else
'If shtLayOut.Cells(lngLayOutRow, 2) = "Number" And shtLayOut.Cells(lngLayOutRow, 3) = "Long Integer" Then
'Set daoFD = daoTB.CreateField(strFieldName, dbLong)
'daoFD.Required = False
'daoFD.DefaultValue = 0
'End If
'End If
'End If
' now a long integer but most others are the same
'strFieldName = "Long_Integer_Field"
'Set daoFD = daoTB.CreateField(strFieldName, dbLong)
' or you can use dbInteger, dbSingle, dbDate, dbCurrency, dbBoolean, dbBinary dbMemo or, dbLongBinary (did I miss any?)
' after each field you need to append it to the table def
daoTB.Fields.Append daoFD
' text is a little different, you need to specify the length
'Set daoFD = daoTB.CreateField(strFieldName, dbText, intFieldLength)
'daoTB.Fields.Append daoFD
' once you've added all the fields then we need to append the table to the tables collection
lngLayOutRow = lngLayOutRow + 1
'Loop
daoDB.TableDefs.Append daoTB
daoDB.Close
daoWS.Close
'There is a table and all the fields now for the indexes - here are some samples
' PrimaryKey"
'Set daoID = daoTB.CreateIndex("PrimaryKey")
'Set daoIF = daoID.CreateField(strFieldName)
'daoID.Primary = True
'daoID.Fields.Append daoIF
'daoTB.Indexes.Append daoID
' Unique"
'Set daoID = daoTB.CreateIndex(strIndexName)
'Set daoIF = daoID.CreateField(strFieldName)
'daoID.Unique = True
'daoID.Fields.Append daoIF
'daoTB.Indexes.Append daoID
' NonUnique"
'Set daoID = daoTB.CreateIndex(strIndexName)
'Set daoIF = daoID.CreateField(strFieldName)
'daoID.Fields.Append daoIF
'daoTB.Indexes.Append daoID
Application.ScreenUpdating = True
End Function
