Database rapidly increases in size!!!

[joebb3]

I have created a database that imports a large number of xls data and puts that data into 3 related tables.

The first table holds the users data, linked to a set of accomplishments semi annually, linked to the particulars of that accomplishment in the last table. Record count is @ 600 records in Table 1 and @ 4000 each in table 2 & 3. Not tons of data.

I use a sub to automaticallly import all the xls files in a directory, one at a time, into temp tables where I extract the data into the proper permenant tables. The methods I use are a straight move, via WITH, to the first table (a dictionary object is used to check for duplicate data). For the second, I use a SQL statememt to ensure that data isn't duplicated in the second table, if it isn't duplicate data, I move the entry into the table. I do the same with the third table.

It all works extremely well, however, the database increases in size to over 100MB after the import!!! If I compress the database, it compresses down to about 3MB!!! Compression takes over a minute to accomplish. (I have included a compress database button as a quick fix, but I would like to find out what I did wrong.

I can post the code if it would help, or is the bloat inherent in my method?

Thank you,
Joe Barneski

 

[straybullet]

Those temporary tables "exist" - taking up space - until the DB is compacted.
Please do post any code being used - I'm sure one of the code gurus would be able to suggest a way to check for those duplicates before appending the new records in such a way as to reduce the bloating.

Let them hate - so long as they fear... Lucius Accius

 

[joebb3]

One disclaimer before I post the code.. I am completely self taught. I'm learning more as I dabble in access from time to time, but I'm sure some of my methods aren't... Ummm... The best. Some of my code I have gotten from the fantasic tips I have found here.

Dim impFilename As Variant
Dim strFilter As String
Dim strInputFileName As String
Dim AH As Variant
Dim dup As Long
Dim db1 As Database
Dim mypath As String
Dim backend As String
Dim tempname As String
Dim testblank As String
Dim memberexists As Object
Dim memberdoes As Variant
Dim cycle As String
Dim idnew As Variant
Dim Msg, Style, TITLE, Response, MyString
Dim conDatabase As DAO.Database
Dim dSQL As String
Dim strFolderName As String
Dim strFolderNamexls As String
Set memberexists = CreateObject("Scripting.Dictionary")
Set db1 = CurrentDb
Set db1r = db1.OpenRecordset("ImportAllData")
Set db2r = db1.OpenRecordset("Members")
Set db3r = db1.OpenRecordset("Cycles")
Set db4r = db1.OpenRecordset("CurrentUIC")
Set db6r = db1.OpenRecordset("BCA")
Set db7r = db1.OpenRecordset("tblFileNames")
Msg = "UIC  " & currentuic & "  Records Imported"    ' Define message.
TITLE = "Success!!!"    ' Define title.
'load Dictionary
With db2r
    If db2r.RecordCount > 0 Then
        .MoveFirst
        memberdoes = memberexists.removeall
        Do While .EOF = False
        lid = db2r![ID]
        lssn = db2r![ssn]
        memberexists.Add lssn, lid
        .MoveNext
        Loop
    End If
End With 
'end Load Dictionary
'open dialog
strFolderName = BrowseFolder("Select the folder that contains your PRT and BCA Spreadsheets?")
If strFolderName <> "" Then
resp = MsgBox("Are you POSITIVE that the subdirectory:" + Chr$(13) + Chr$(13) + strFolderName + "\" + Chr$(13) + Chr$(13) + "contains your PROPERLY FORMATED PRT and BCA spreadsheets ???", vbYesNo, "Verification !!!")
If resp = 7 Then
Exit Sub
End If
strFolderNamexls = Dir$(strFolderName + "\*.xls")
If Right$(strFolderNamexls, 7) <> "bca.xls" Then
SaveFileName (strFolderNamexls)
End If
Do
    strFolderNamexls = Dir$
If Right$(strFolderNamexls, 7) <> "bca.xls" Then
    SaveFileName (strFolderNamexls)
End If

Loop Until strFolderNamexls = ""
    'do delete queries and import xls files
    With db7r
    .MoveFirst
    Do While .EOF = False
    filenameimp = strFolderName + "\" + db7r![filename]
    filenamelen = Len(filenameimp)
    Finalsave = Left(filenameimp, filenamelen - 4)
    Finalsaveb = Finalsave + "bca.xls"
    DoCmd.OpenQuery "ImportCycles"
    DoCmd.OpenQuery "ImportBCA"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "CurrentUIC", filenameimp, True, "PRTEdit!a1:a2"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImportAllData", filenameimp, True, "PRTEdit!a4:n"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "ImportBCAData", Finalsaveb, True, "BCEdit!a4:q"
        
        With db4r 'pull UIC from table
            .MoveFirst
            currentuica = db4r![PRT List]
            currentuic = Mid(currentuica, 5, 5)
                If currentuic = "DEPT " Then
                    currentuic = Mid(currentuica, 10, 5)
                End If
                If currentuic = "DEPT/" Then
                   currentuic = Mid(currentuica, 14, 5)
                End If
            .Delete
        End With ' end pull UIC
        
        With db1r  ' with Record from import files
            .MoveFirst
            Do While .EOF = False
                idid = db1r![ssn]
                cycle = db1r![prt cycle]
               dup = 0
' search current members for a duplicate
                     With db2r                           
                     memberdoes = memberexists.exists(idid)
                            If memberdoes = True Then
                                dup = 1
                            End If
                            If dup = 0 Then
                                .AddNew
                                db2r![name] = db1r![name]
                                db2r![rank] = db1r![rank]
                                db2r![uic] = currentuic
                                db2r![ssn] = db1r![ssn]
                                ID = db2r![ID]
                                'Namenew = db2r![name]
                                memberexists.Add idid, ID
                                .Update
                            End If
                    End With 
' end search members for duplicate
                   Set conDatabase = CurrentDb
                    dSQL = "Select * into passCycleData from Cycles where [ssn]='" + idid + "' and [cycle]='" + cycle + "'"
                    conDatabase.Execute dSQL
                    'sSQL = ""
                Set db8r = db1.OpenRecordset("passCycleData")
                With db3r
                    cycle = db1r![prt cycle]
                    cyclesorta = cycle
                    cyclesortpos = InStr(4, cyclesorta, " ") + 1
                    cyclesortyear = Mid(cyclesorta, cyclesortpos, 4)
                        If cyclesortpos = 6 Then
                            cyclesortyear = cyclesortyear + 0.5
                        End If
                    If Val(cyclesortyear) <= defHist Then
                        With db8r
                        If db8r.RecordCount > 0 Then
                            cdup = 1
                        End If
                        End With

                    If cdup <> 1 Then
                        .AddNew
                        db3r![ID] = ID
                        CID = db3r![CID]
                        db3r![ssn] = db1r![ssn]
                        db3r![cycle] = db1r![prt cycle]
                        db3r![cyclesort] = cyclesortyear
                        db3r![status] = db1r![prt status]
                        db3r![testdate] = db1r![prt test date]
                        db3r![upperbody] = db1r![upperbody]
                        db3r![core] = db1r![core]
                        db3r![cardio] = db1r![cardio]
                        db3r![overall] = db1r![overall category]
                        .Update
                     End If
                    End If
                End With
                    db8r.Close
                    dSQL = "Drop Table passCycleData"
                    conDatabase.Execute dSQL
                
                If Val(cyclesortyear) <= defHist Then
                    Set conDatabase = CurrentDb
                    dSQL = "Select * into CurrentBCARecord from ImportBCAData where [ssn]='" + idid + "' and [prt cycle]='" + cycle + "'"
                    conDatabase.Execute dSQL
                    Set db5r = db1.OpenRecordset("CurrentBCARecord")
                    
                    With db6r
                    dSQL = "Select * into passBCAData from BCA where [ssn]='" + idid + "' and [cycle]='" + cycle + "'"
                    conDatabase.Execute dSQL
                    Set db9r = db1.OpenRecordset("passBCAData")
                        With db9r
                        If db9r.RecordCount > 0 Then
                            bdup = 1
                        End If
                        End With

                    If bdup <> 1 Then
                        .AddNew
                        db6r![ID] = ID
                        db6r![ssn] = db5r![ssn]
                        db6r![cycle] = db5r![prt cycle]
                        db6r![cyclesort] = cyclesortyear
                        db6r![BCstatus] = db5r![BC status]
                        db6r![BCdate] = db5r![BC date]
                        db6r![hgt/wgtok] = db5r![hgt/wgt ok]
                        db6r![BFOK] = db5r![BF OK]
                        db6r![BF%] = db5r![BF%]
                        db6r![CID] = CID
                        .Update
                    End If
                    db9r.Close
                    dSQL = "Drop Table passBCAData"
                    conDatabase.Execute dSQL

                    End With
                    db5r.Close
                    conDatabase.Close
                    DoCmd.DeleteObject acTable, "CurrentBCARecord"
                End If
                dup = 0
                cdup = 0
                bdup = 0
            .MoveNext
            Loop
        End With
    .MoveNext
    Loop
    End With
    
    Msg = currentrecimp & "  Records Imported"    ' Define message.
    TITLE = "Success!!!"    ' Define title.
    MsgBox Msg, vbOKOnly, TITLE
    DoCmd.OpenQuery "delFileNames"
    DoCmd.Close acForm, "Main"
    DoCmd.OpenForm "Main"
    DoCmd.OpenQuery "MakeUICTable"
End If
memberexists.removeall

db1.Close

Well... There it is.

Thanx,
Joe

 

[joebb3]

I don't really need a step by step... Just a suggestion or two and I can figure it out from there.

Thanx!
Joe