I searched everywhere for code that would work and found almost nothing to help so I am posting this here for posterity.
Background. We are migrating from Goldmine to Microsoft CRM Online. When moving email is very big. CRM Online will only take a file 8meg max. So I had to import the email into several databases to get 10 years of email history over. But on top of that after I had cleaned up the data in each database I had to export them to .csv files that were 8meg or less. I wanted to get as many records as possible into the file due to the fact that we are talking about 500meg + of data. What I came with was a modified version of the code from this post [/url] and some code of my own after that. I know there is a more efficient way to do it up here is what I came up with.
This is the modified code I linked to above. All I did was change it so that it would only check the size of a single table. This way it works faster. In the production mode I also took out the debug.print lines so that it would run faster as well.
This is the part I had to come up with on my own. All you have to do in change the constants to reflect the sizes that are your best guess to get the size file you want. It takes some trial and error to get it right. Once you get it take out the debug.print lines to speed things up. I added a progress form to keep me from getting board while it cycled through 100k+ records. Other than the max file and table size variables the others just go towards efficiency. By changing the intmaxreccnt for example will just allow it to add more records to the table before it starts checking the size. Changing the intchksizeinvl variable tells it how many more records to add before it checks again.
I hope this helps someone in the future. It took me two days to figure this out and test. Of course my database crashed after the first day and I had forgotten to save. I had to start all over 
. Anyway have fun.
Background. We are migrating from Goldmine to Microsoft CRM Online. When moving email is very big. CRM Online will only take a file 8meg max. So I had to import the email into several databases to get 10 years of email history over. But on top of that after I had cleaned up the data in each database I had to export them to .csv files that were 8meg or less. I wanted to get as many records as possible into the file due to the fact that we are talking about 500meg + of data. What I came with was a modified version of the code from this post [/url] and some code of my own after that. I know there is a more efficient way to do it up here is what I came up with.
This is the modified code I linked to above. All I did was change it so that it would only check the size of a single table. This way it works faster. In the production mode I also took out the debug.print lines so that it would run faster as well.
Code:
'---------------------------------------------------------------------------------------
' Procedure : ListAllTables_Size
' Author : Gustav(original)
' Created : 11/15/2009
' Purpose : To get approximate sizes of all
'non-MSys tables in an Access mdb.
'Outputs table names and sizes to immediate window.
'
'From AccessD discussion-
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: Microsoft DAO 3.6 Object Library
'------------------------------------------------------------------------------
'
Public Function ListAllTables_Size(tblname As String) As Long
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strName As String
Dim strFile As String
Dim strPath As String
Dim lngBase As Long
Dim lngSize As Long
On Error GoTo ListAllTables_Size_Error
Set dbs = CurrentDb
strName = dbs.Name
strPath = Left(strName, Len(strName) - Len(Dir(strName)))
' Create empty database to measure the base file size.
strFile = strPath & "base" & ".mdt"
CreateDatabase strFile, dbLangGeneral
lngBase = FileLen(strFile)
Kill strFile
Debug.Print "Base size", lngBase
For Each tdf In dbs.TableDefs
strName = tdf.Name
' Apply some filtering - ignore System tables.
If Left(strName, 4) <> "MSys" Then
If strName = tblname Then
strFile = strPath & strName & ".mdt"
Debug.Print strName, ;
CreateDatabase strFile, dbLangGeneral
DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strName, strName
lngSize = FileLen(strFile) - lngBase
Kill strFile
Debug.Print "Table Size: " & lngSize
ListAllTables_Size = lngSize
End If
End If
Next
Set tdf = Nothing
Set dbs = Nothing
On Error GoTo 0
Exit Function
ListAllTables_Size_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ListAllTables_Size "
End Function
Code:
Function exportMultipleFiles()
Dim rs1 As New ADODB.Recordset
Dim strSQLrs1 As String
Dim rs2 As New ADODB.Recordset
Dim strSQLrs2 As String
Dim strFileBase, strFileSuf, strFileExt, strFileName As String
Dim lprog, lMaxFileSize, lCurFileSize, lMaxTblSize, lNxtRecChk, lMinFileSize As Long
Dim lFstRecID, lTblSizeChgInt, lMaxTblSizeBase, lLastFileRecCnt As Long
Dim intMaxRecCnt, intChkSizeIntvl, intCurCnt, intFileNum, intLastFileNum As Integer
Dim i As Integer
Dim blnRedoExp As Boolean
strSQLrs1 = "" & _
"SELECT tbl_GMRAW_Mailbox.MACCOUNTNO, tbl_GMRAW_Mailbox.MAILDATE , " & _
" tbl_GMRAW_Mailbox.MRECID , tbl_GMRAW_Mailbox.MESSAGE , " & _
" tbl_GMRAW_Mailbox.CHRECTYPE , tbl_GMRAW_Mailbox.SENDER , " & _
" tbl_GMRAW_Mailbox.RECIPIENT , tbl_GMRAW_Mailbox.SUBJECT , " & _
" tbl_GMRAW_Mailbox.status , tbl_GMRAW_Mailbox.contactid, " & _
" tbl_GMRAW_Mailbox.id " & _
"FROM tbl_GMRAW_Mailbox;"
rs1.Open strSQLrs1, CurrentProject.Connection, adOpenStatic
strSQLrs2 = "" & _
"SELECT tbl_TEMPLATE_Mailbox.MACCOUNTNO, tbl_TEMPLATE_Mailbox.MAILDATE, " & _
" tbl_TEMPLATE_Mailbox.Mrecid , tbl_TEMPLATE_Mailbox.MESSAGE , " & _
" tbl_TEMPLATE_Mailbox.CHRECTYPE , tbl_TEMPLATE_Mailbox.SENDER , " & _
" tbl_TEMPLATE_Mailbox.RECIPIENT , tbl_TEMPLATE_Mailbox.SUBJECT , " & _
" tbl_TEMPLATE_Mailbox.status , tbl_TEMPLATE_Mailbox.contactid " & _
"FROM tbl_TEMPLATE_Mailbox;"
rs2.Open strSQLrs2, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
DoCmd.OpenForm "frm_progress"
intprog = 0
lMaxFileSize = 7900000
lMinFileSize = maxfilesize - 250000
lMaxTblSizeBase = 19000000
lMaxTblSize = lMaxTblSizeBase
lTblSizeChgInt = 1000000
lCurFileSize = 0
intMaxRecCnt = 5000
lNxtRecChk = intMaxRecCnt
intChkSizeIntvl = 200
intCurCnt = 0
intFileNum = 0
intLastFileNum = 0
strFileBase = "mailbox"
strFileExt = ".csv"
strFileSuf = "000"
blnRedoExp = False
lFstRecID = 0
lLastFileRecCnt = 0
DoCmd.SetWarnings False
DoCmd.OpenQuery "EXPORT_MailboxTemplateClearTable"
DoCmd.SetWarnings True
Do While Not rs1.EOF
If lFstRecID = 0 Then
lFstRecID = rs1!id
Else
'Value Already Set
End If
intCurCnt = intCurCnt + 1
lprog = lprog + 1
Forms!frm_progress!prog.Caption = "Exporting " & lprog & " records of " & rs1.RecordCount & " to " & strFileName
Pause 0.01
If intCurCnt > lNxtRecChk Then
If ListAllTables_Size("tbl_template_mailbox") > lMaxTblSize Then
If blnRedoExp = fase Then
intLastFileNum = intFileNum
intFileNum = intFileNum + 1
Select Case Len(intFileNum)
Case 0 To 9
strFileSuf = "00" & CStr(intFileNum)
Case 10 To 99
strFileSuf = "0" & CStr(intFileNum)
Case 100 To 9999
strFileSuf = CStr(intFileNum)
End Select
strFileName = strFileBase & strFileSuf & strFileExt
Else
'file name stays the same so we can overwrite with different records.
End If
'export file
DoCmd.TransferText acExportDelim, , "tbl_TEMPLATE_Mailbox", strFileName, True
Debug.Print strFileName
Debug.Print FileLen(strFileName)
If FileLen(strFileName) < lMinFileSize Then
'Continue to Add Records and Resave File
blnRedoExp = True
lNxtRecChk = lNxtRecChk + intChkSizeIntvl
ElseIf FileLen(strFileName) > lMaxFileSize Then
'Go back and rebuild file with less records
blnRedoExp = True
'Clear Table
DoCmd.SetWarnings False
DoCmd.OpenQuery "EXPORT_MailboxTemplateClearTable"
DoCmd.SetWarnings True
lNxtRecChk = lMaxFileSize \ (FileLen(strFileName) / (intCurCnt - lLastFileRecCnt))
rs1.Find "[id] = " & lFstRecID, , adSearchBackward
lprog = rs1.AbsolutePosition
intCurCnt = lLastFileRecCnt
lMaxTblSize = lMaxTblSize - lTblSizeChgInt
Else
'Clear Table
DoCmd.SetWarnings False
DoCmd.OpenQuery "EXPORT_MailboxTemplateClearTable"
DoCmd.SetWarnings True
lLastFileRecCnt = rs1.AbsolutePosition
lNxtRecChk = lNxtRecChk + intMaxRecCnt
lFstRecID = rs1!id
blnRedoExp = False
lMaxTblSize = lMaxTblSizeBase
End If
Else
lNxtRecChk = intCurCnt + intChkSizeIntvl
'Continue to Add to Table
End If
Else
'Continue to Add to Table
End If
rs2.AddNew
For i = 1 To rs2.Fields.Count - 1
rs2.Fields(i).Value = rs1.Fields(i).Value
Next
rs2.Update
rs1.MoveNext
Loop
rs1.Close
rs2.Close
Set rs1 = Nothing
Set rs2 = Nothing
DoCmd.Close acForm, "frm_progress"
End Function
