Attempting to create summary records in a table for large number of tables

Atroxell

Active Member
Joined
Apr 18, 2007
Messages
422
OK, this is still my very first attempt at doing anything of substance with Access VBA so if I am heading in the wrong direction with any of this, please feel free to speak up.

Intially the code performs a check to see if the master customer file is available on either the first or the 15th of each month. If it is and it has not been imported, import it. Otherwise use the latest version.

And then the code loops to:

1) Import 102 .csv files representing various geographies in the State.

2) Compare the imported files to the master file in (created if necessary just before the loop) to find matches. If they match, create a table with a unique name and date stamp.

3) Export the unique tables back out to .csv files for another department to use.

4) Delete the initially imported table in step 1.

This is the code. With the exception of the code that attempts to write a record to the Summary Count table, it works perfectly. Only since I added the rstSum code has it given me any problems.

Code:
Dim rst As Recordset
Dim rstSum As Recordset
Dim rstExported As Recordset
Dim rtsImported As Recordset
Sub scan_Tbl()
        ' Clear the error stack.
        Err.Clear
 
        ' Turn off system warnings.
        DoCmd.SetWarnings 0
        ' First check to make sure the IT Comparison file exists.
        import_IT_File
 
        ' reset the date variables to today's date.
        dateMath.dateMath 1
 
        ' Turn off error trapping for the directory structure check.
        On Error Resume Next
 
        ' Check to make sure the destination folder exists.
        x = GetAttr("M:\Web\@Al's Lists\" & monthDir) And 0
        If Err = 0 Then
 
                ' Return to the working directory.
                ChDir acSysCmdAccessDir
        Else
 
                ' There are no files, so create the directory.
                MkDir "M:\Web\@Al's Lists\" & monthDir
        End If
        ' Define an error trap.
        'On Error GoTo import_Fail
 
        ' create an object for the current db.
        Set db = CurrentDb
 
        ' Establish a connection to the Summary Report Table to view imported and finished record counts.
        'Set rstSum = db.OpenRecordset("Summary Counts", , 8, 2)
 
        ' Create a tableview that can be used to define the queries and file naming for the loop.
        Set rst = db.OpenRecordset("SELECT [MCIF File Relationships].Query_Name, [MCIF File Relationships].From," _
                & "[MCIF File Relationships].To, [MCIF File Relationships].Export_Name FROM [MCIF File Relationships]")
 
        ' Go to the first and last record of the table that was just created.
        'rst.MoveFirst
        rst.MoveLast
 
        ' Count the number of records in that record set.
        recCnt = rst.RecordCount
 
        ' Move back to the first record.
        rst.MoveFirst
 
        ' Now we'll reuse x as a counter for the export.
        x = 0
 
        ' Open the SUMMARY table for use as count recorder.
        Set rstSum = db.OpenRecordset("Summary Counts")
 
        ' Using the open recordset, loop through records.
        With rst
                Do Until .EOF
 
                        ' Add a record to the SUMMARY table.
                        rstSum.AddNew
 
                        'Assign edit capability here.
                        rstSum.Edit
 
                        ' Add data to the new record in the SUMMARY table.
                        rstSum("tbl_Date").Value = Now()
 
                        ' Add the name of the geogrpahy being imported to the record.
                        rstSum("tbl_Name").Value = !Export_Name
 
                        ' Post the updated record.
                        rstSum.Update
                        x = x + 1
 
                        ' These are here just to allow the developer to see the values in the watch window.
                        tblName = !Export_Name & " " & mm & dd & yy
                        sourcefile = !FROM & "\" & !Query_Name & ".csv"
                        outputName = !To & "\" & !Export_Name & " " & mm & dd & yy & ".csv"
 
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Attempting to import file # " & x & " of  " & recCnt & _
                                                " ... (" & !Query_Name & ")")
 
                        'DoCmd.TransferText(TransferType, SpecificationName, TableName, FileName, HasFieldNames, HTMLTableName, CodePage)
                        DoCmd.TransferText acImportDelim, "MCIF_IMPORT_SPECS", !Export_Name & " " & mm & dd _
                                                & yy, !FROM & "\" & !Query_Name & ".csv"
 
                        ' Open the freshly imported table. .OpenRecordset(Name, Type, Options, LockEdit)
                        Set rstImported = .OpenRecordset(tblName)       [B][COLOR=red]<-FAILS HERE IN POINT 2 BELOW[/COLOR][/B]
 
                        ' Move to the last record in the imported table--this forces the actual count of records to be recognized.
                        rstImported.MoveLast
 
                        ' Post the count of records in the new table to the Summary Table.
                        rstSum("Import_Count").Value = rstImported.RecordCount
 
                        ' Post the updated record.
                        rstSum.Update
 
                        ' Close the freshly imported table.
                        rstImported.Close
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Querying the " & !Export_Name & " file against " & ITSource)
 
                        ' Compare the newly imported file to the current IT email file and pull the matching records.
                        DoCmd.RunSQL _
                                "SELECT [" & ITList & "].NAME," _
                                        & "[" & ITList & "].EMAIL " _
                                        & "INTO [" & !Export_Name & " " & mm & dd & yy & " Final ]" _
                                        & "FROM [" & !Export_Name & " " & mm & dd & yy & "] " _
                                        & "INNER JOIN [" & ITList & "]" _
                                        & "ON [" & !Export_Name & " " & mm & dd & yy & "].SSN = " _
                                                & "[" & ITList & "].SSN;"
 
                        ' Open the record set created by the query.
                        Set rstExported = .OpenRecordset(outputName)
 
                        rstExported.MoveFirst
                        ' Again move to the last record in the imported table--this forces the actual count of records to be recognized.
                        rstExported.MoveLast
 
                        ' Get the number of records in the query result table.
                        rstSum("Export_Count").Value = rstExported.RecordCount
 
                        ' Close the query result.
                        rstExported.Close
 
                        ' Calculate the match success and post it to the SUMMARY table.
                        rstSum("Success") = rstSum("Export_Count") / rstSum("Import_Count")
 
                        ' Post the updated record.
                        rstSum.Update
 
                        ' Delete the original source file from the MCIF--we do not need it anymore.
                        DoCmd.DeleteObject acTable, !Export_Name & " " & mm & dd & yy
 
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Exporting the " & !Export_Name & " file to ""M:\Web\@Al's Lists" & _
                                                                tmpMonthDir & "\" & !Export_Name & "Final" & ".csv")
 
                        ' Now export the final file to the M:\Web\@Al's Lists\ & monthDir folder.
                        DoCmd.TransferText acExportDelim, "export_Final", !Export_Name & " " & mm & dd & yy & " Final", "M:\Web\@Al's Lists\" & _
                                monthDir & "\" & !Export_Name & " " & mm & dd & yy & ".csv", True
                        .MoveNext
                Loop
        End With
 
        ' Always close the record set.
        rst.Close
 
        ' Clear the messages from the statusbar.
        varStatus = SysCmd(acSysCmdSetStatus, " ")
 
        ' Restore the warning messages.
        DoCmd.SetWarnings -1
 
        Exit Sub
 
import_Fail:
        ' Give the user a message for the error.
        varStatus = SysCmd(acSysCmdSetStatus, Err.Description)
 
        ' Restore the warning messages.
        DoCmd.SetWarnings -1
End Sub
 
Function import_IT_File()
        ' We need to figure out the most current IT sourced email list name. This file should appear on the first
        ' and fifteenth of each month.
        dateMath.dateMath 7
 
        ' We define this name as a Public variable so we can use it in the main query (above).
        ITList = "Email Source " & mm & dd & yy
 
        ' Test to see if the most current IT source file is already in existence.
        If TableExists("Email Source " & mm & dd & yy) = False Then
 
                varStatus = SysCmd(acSysCmdSetStatus, "Importing the " & "Email Source " & mm & dd & yy & " table...")
 
                ' and import the file using the "IT EMail Import" specs.
                DoCmd.TransferText acImportDelim, "IT EMail Import", "Email Source " & mm & dd & yy, _
                                "R:\Email_Lists\G1MKG033_" & dd & mmm & Year(dater) & ".TXT"
        End If
End Function

Now, here are the problems/challenges I have:

1) I am trying to create a situation where the code will automatically append and update a new record in the table named "Summary Counts". This record will contain the Date, table name, imported and exported record count and a % of success. At this point in time, the records are overwritten each time the loop iterates, leaving just one record in the table instead of 102. How do I append records to the table so it will not overwrite the existing record?

2) When I enable the statement "DoCmd.SetWarnings 0", the code fails at "Set rstImported = .OpenRecordset(tblName)" right after the import. But when I disable it with a ', the codes runs the import/comparison/export just fine except for the fact that I have to click "Yes" every time the query produces a table. (The problem in #1 persists in this instant, though.)

Anyone have any insights to this?
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Put Option Explicit at the top of all of your modules; it will force you to explicitly dim your variables which is a good thing. This will also show you the error of your ways. :)

You open the rst variable then use With. Under that you use
Code:
Set rstImported = .OpenRecordset(tblName)
which is calling the OpenRecordset method of the currently open recordset variable rst. So you're opening a recordset then trying to open it again without closing it first. I assume you instead mean
Code:
Set rstImported = CurrentDB.OpenRecordset(tblName)



Finally for updates you may think about creating an update query and run it rather than open a recordset and update like you're doing. You can create and run your update query in code like this

Code:
dim sql as string
sql="INSERT INTO MyTable ( SomeField, SomeOtherField ) " & _
     "SELECT '" & SomeData & "', " & SomeOtherData
CurrentDb.Execute sql

You'll have to play with the names obviously and you'll have to insert your values as appropriate to your update but you'll save a bunch of lines of code with this technique. This can even be done in your loop if you want.

hth,

Rich
 
Last edited:
Upvote 0
Thanks for your reply!

I will jump on this first thing in the morning, as my day is winding down at this time.

It figures that one of the few times I do not use "Option Explicit" it would get me in trouble... :) I always use it in Excel because I set it to default to that statement. But I have not written in Access before, so I missed that.

Not sure I recognize exactly what's going on in the second part of the post, but it may be clearer when I revisit the code in the morning.

Thanks again!
 
Upvote 0
Well, I go it all working. Now to figure out how to build a report. I know I can query the latest date and base a report on that table, but I like to push my limits with design a bit to force my "edumacation". I'm thinking a list box on the report so I can select any date from the Summary Count table and update the report that way... we'll see!

Anyway, for anyone who might be interested in the solution I figured out, here's the code:

Code:
Dim rst As Recordset
Dim rstSummary As Recordset
Dim rstExported As Recordset
Dim rtsImported As Recordset
Sub scan_Tbl()
        ' Clear the error stack.
        Err.Clear
 
        ' Turn off system warnings.
        DoCmd.SetWarnings 0
        ' First check to make sure the IT Comparison file exists.
        import_IT_File
 
        ' reset the date variables to today's date.
        dateMath.dateMath 1
 
        ' Turn off error trapping for the directory structure check.
        On Error Resume Next
 
        ' Check to make sure the destination folder exists.
        x = GetAttr("M:\Web\@Al's Lists\" & monthDir) And 0
        If Err = 0 Then
 
                ' Return to the working directory.
                ChDir acSysCmdAccessDir
        Else
 
                ' There are no files, so create the directory.
                MkDir "M:\Web\@Al's Lists\" & monthDir
        End If
        ' Define an error trap.
        On Error GoTo import_Fail
 
        ' create an object for the current db.
        Set db = CurrentDb
 
        ' Establish a connection to the Summary Report Table to view imported and finished record counts.
        'Set rstSummary = db.OpenRecordset("Summary Counts", , 8, 2)
 
        ' Create a tableview that can be used to define the queries and file naming for the loop.
        Set rst = db.OpenRecordset("SELECT [MCIF File Relationships].Query_Name, [MCIF File Relationships].From," _
                & "[MCIF File Relationships].To, [MCIF File Relationships].Export_Name FROM [MCIF File Relationships]")
 
        ' Go to the first and last record of the table that was just created.
        'rst.MoveFirst
        rst.MoveLast
 
        ' Count the number of records in that record set.
        recCnt = rst.RecordCount
 
        ' Move back to the first record.
        rst.MoveFirst
 
        ' Now we'll reuse x as a counter for the export.
        x = 0
 
        ' Open the SUMMARY table for use as count recorder.
        Set rstSummary = db.OpenRecordset("Summary Counts")
 
        ' Using the open recordset, loop through records.
        With rst
                Do Until .EOF
 
                        ' Add a record to the SUMMARY table.
                        rstSummary.AddNew
 
                        ' Add data to the new record in the SUMMARY table.
                        rstSummary("tbl_Date").Value = Now()
 
                        ' Add the name of the geography being imported to the record.
                        rstSummary("tbl_Name").Value = !Export_Name
 
                        ' Post the updated record.
                        rstSummary.Update
 
                        ' Make the new record the current record.
                        rstSummary.Bookmark = rstSummary.LastModified
                        x = x + 1
 
                        ' These are here just to allow the developer to see the values in the watch window.
                        tblName = !Export_Name & " " & mm & dd & yy
                        sourcefile = !FROM & "\" & !Query_Name & ".csv"
                        outputName = !To & "\" & !Export_Name & " " & mm & dd & yy & ".csv"
 
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Attempting to import file # " & x & " of  " & recCnt & _
                                                " ... (" & !Query_Name & ")")
 
                        'DoCmd.TransferText(TransferType, SpecificationName, TableName, FileName, HasFieldNames, HTMLTableName, CodePage)
                        DoCmd.TransferText acImportDelim, "MCIF_IMPORT_SPECS", !Export_Name & " " & mm & dd _
                                                & yy, !FROM & "\" & !Query_Name & ".csv"
 
                        ' Open the freshly imported table. .OpenRecordset(Name, Type, Options, LockEdit)
                        Set rstImported = db.OpenRecordset(tblName)
 
                        ' Move to the last record in the imported table--this forces the actual count of records to be recognized.
                        rstImported.MoveLast
 
                        'Assign edit capability here.
                        rstSummary.Edit
 
                        ' Post the count of records in the new table to the Summary Table.
                        rstSummary("Import_Count").Value = rstImported.RecordCount
 
                        ' Post the updated record.
                        rstSummary.Update
 
                        ' Close the freshly imported table.
                        rstImported.Close
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Querying the " & !Export_Name & " file against " & ITSource)
 
                        ' Compare the newly imported file to the current IT email file and pull the matching records.
                        DoCmd.RunSQL _
                                "SELECT [" & ITList & "].NAME," _
                                        & "[" & ITList & "].EMAIL " _
                                        & "INTO [" & !Export_Name & " " & mm & dd & yy & " Final ]" _
                                        & "FROM [" & !Export_Name & " " & mm & dd & yy & "] " _
                                        & "INNER JOIN [" & ITList & "]" _
                                        & "ON [" & !Export_Name & " " & mm & dd & yy & "].SSN = " _
                                                & "[" & ITList & "].SSN;"
 
                        ' Open the record set created by the query.
                        Set rstExported = db.OpenRecordset(!Export_Name & " " & mm & dd & yy & " Final")
 
                        rstExported.MoveFirst
 
                        ' Again move to the last record in the imported table--this forces the actual count of records to be recognized.
                        rstExported.MoveLast
 
                        'Assign edit capability here.
                        rstSummary.Edit
 
                        ' Get the number of records in the query result table.
                        rstSummary("Export_Count").Value = rstExported.RecordCount
 
                        ' Post the updated record.
                        rstSummary.Update
 
                        ' Close the query result.
                        rstExported.Close
 
                        'Assign edit capability here.
                        rstSummary.Edit
 
                        ' Calculate the match success and post it to the SUMMARY table.
                        rstSummary("Success") = rstSummary("Export_Count") / rstSummary("Import_Count")
 
                        ' Post the updated record.
                        rstSummary.Update
 
                        ' Delete the original source file from the MCIF--we do not need it anymore.
                        DoCmd.DeleteObject acTable, !Export_Name & " " & mm & dd & yy
 
                        ' Message the user
                        varStatus = SysCmd(acSysCmdSetStatus, "Exporting the " & !Export_Name & " file to ""M:\Web\@Al's Lists" & _
                                                                tmpMonthDir & "\" & !Export_Name & "Final" & ".csv")
 
                        ' Now export the final file to the M:\Web\@Al's Lists\ & monthDir folder.
                        'DoCmd.TransferText acExportDelim, "export_Final", !Export_Name & " " & mm & dd & yy & " Final", "M:\Web\@Al's Lists\" & _
                        '        monthDir & "\" & !Export_Name & " " & mm & dd & yy & ".csv", True
                        .MoveNext
                Loop
        End With
 
        ' Always close the record set.
        rst.Close
 
        ' Clear the messages from the statusbar.
        varStatus = SysCmd(acSysCmdSetStatus, " ")
 
        ' Restore the warning messages.
        DoCmd.SetWarnings -1
 
        Exit Sub
 
import_Fail:
        ' MsgBox(prompt[, buttons] [, title] [, helpfile, context])
        chkVal = MsgBox(Err.Description, 0, "Error") ' [, helpfile, context])
        ' Give the user a message for the error.
        'varStatus = SysCmd(acSysCmdSetStatus, Err.Description)
        ' Restore the warning messages.
        DoCmd.SetWarnings -1
End Sub
 
Function import_IT_File()
        ' We need to figure out the most current IT sourced email list name. This file should appear on the first
        ' and fifteenth of each month.
        dateMath.dateMath 7
 
        ' We define this name as a Public variable so we can use it in the main query (above).
        ITList = "Email Source " & mm & dd & yy
 
        ' Test to see if the most current IT source file is already in existence.
        If TableExists("Email Source " & mm & dd & yy) = False Then
 
                varStatus = SysCmd(acSysCmdSetStatus, "Importing the " & "Email Source " & mm & dd & yy & " table...")
 
                ' and import the file using the "IT EMail Import" specs.
                DoCmd.TransferText acImportDelim, "IT EMail Import", "Email Source " & mm & dd & yy, _
                                "R:\Email_Lists\G1MKG033_" & dd & mmm & Year(dater) & ".TXT"
        End If
End Function

This code uses a table named "MCIF Realtionships" as the source for many of the naming conventions for the import and export of the files.

FYI: the dataMath() sub is just a block of code I use to calculate the various parts of the date that I need, such as month, year, day, abbreviations, special concatenated values, etc. I just found myself using date values so much that I wrote an independent Sub() for that purpose. There is a Select...End Select block in dateMath() that I use to decide which date I am referring to, which is why I pass a number to it. The number sets the values for the Select statement. 1 is today, 2 is last Sautrday, 3 is next Saturday, etc. With my dateMath() sub, I can flipflop between dates and date variables with a quick line of code rather than writing several lines. This sub has followed me for about 15 years across several languages.

Thank you, Rich, for your help with this!
 
Upvote 0
Interesting, you've still Dim'd "rtsImported" for your recordset yet you're using "rstImported".

As for your listbox idea, this can work but not *on* your report. The data on a report isn't terribly interactive. You'll want to set up a form with this listbox then get your report's recordsource to look at the form/listbox. I'm sure a search on this forum will yield some good stuff as it's a common request.

hth,

Rich
 
Upvote 0
Well, while searching for something else I revisited this thread. You are absolutely correct--I transposed the "rst" and "rts" in the code above. I later went back and corrected it. Works great.

And I think by looking at the same post to which you are referring you will see in my reply that "fat-fingering" and transposing letters is one of my oldest nemesis. :biggrin:
 
Upvote 0

Forum statistics

Threads
1,215,603
Messages
6,125,786
Members
449,259
Latest member
rehanahmadawan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top