In VBA Query cannot be completed - mysql

I want to find the sum of records from different tables and insert the output in a new column, when I run the code it show me the error:
"The query cannot be completed. Either the size of the query result is
larger than the maximum size of the database (2GB) or there is not enough
temporary storage space on the disk to store the query result"
And it highlight the line
STD.Open sql, cnn, adOpenStatic
My code is the following
Option Compare Database
Option Explicit
Public cnn As New ADODB.Connection
Public db As DAO.Database
Public Sub SMain()
Set db = Access.Application.CurrentDb
Set cnn = CurrentProject.Connection
Get_Value
End Sub
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
Do Until ODR.EOF
DoEvents
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID"
STD.Open sql, cnn, adOpenStatic
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col= STD!TOTAL_N
ODR.Update
End If
STD.Close
ODR.MoveNext
Loop
End Sub
What mistake I did?
And am I calling the output correctly on
ODR!New_Col= STD!TOTAL_N

If the query is too big (which the error message indicates), then let's split it into smaller chunks. This is only properly possible in MySQL, Access doesn't support LIMIT or OFFSET, workarounds are messy, especially for totals queries
I'm making a few assumptions here:
All relevant tables are stored within the same MySQL database
Your tables have valid connection strings that can be used for ADO
Note that executing the query in MySQL alone is probably enough to fix this error.
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
'Create a new ADODB connection that's directly to MySQL, and doesn't use Access
Dim adoConn2 As ADODB.Connection
adoConn2.ConnectionString = CurrentDb.TableDefs("MONT_VOL").Connect
adoConn2.Open
'Initialize variables used for pagination
Dim RecordCount As Integer
Dim PageSize As Integer
Dim Offset As Integer
Offset = 0
RecordCount = 1
PageSize = 100
Do Until ODR.EOF
DoEvents
While RecordCount <> 0
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID" & _
" LIMIT " & Offset & "," & PageSize
STD.Open sql, adoConn2, adOpenStatic
RecordCount = STD.RecordCount
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col = STD!TOTAL_N
ODR.Update
End If
STD.Close
Offset = Offset + PageSize
Wend
ODR.MoveNext
Loop
adoConn2.Close
End Sub

Related

How to get bigdata from one table and insert into another in VBA?

I have table with columns like key,English Phrase and that phrase with other 40 languages.See in following image :
I want to break the records of these table by it's language column like following image:
I did this using the following code:
Sub InsertIntoMasterPhrases()
Dim objRecordsetMaster As ADODB.Recordset
Set objRecordsetMaster = New ADODB.Recordset
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordsetMaster.ActiveConnection = CurrentProject.Connection
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordsetMaster.Open ("SELECT [Master Table].* FROM [Master Table];")
While objRecordsetMaster.EOF = False
objRecordset.Open ("Select [SAP_LANGUAGE to LANG].[LANGUAGE NAME], [SAP_LANGUAGE to LANG].[LANGUAGE] " & _
"From [SAP_LANGUAGE to LANG]")
While objRecordset.EOF = False
key = objRecordsetMaster.Fields("Key").Value
englishPhrase = objRecordsetMaster.Fields("English Phrase").Value
language = objRecordset.Fields("LANGUAGE").Value
translation = objRecordsetMaster.Fields(languageName).Value
If (GetRecordsExist(CStr(key), CStr(englishPhrase), CStr(language)) = "") Then
Query = "INSERT INTO [Language Sample](Key,English,Translation,Language)VALUES ('" & key & "','" & englishPhrase & "','" & translation & "','" & language & "');"
CurrentDb.Execute Query
End If
objRecordset.MoveNext
Wend
objRecordset.Close
objRecordsetMaster.MoveNext
Wend
objRecordsetMaster.Close
End Sub
//Checking records already exist in table
Function GetRecordsExist(key As String, english As String, language As String) As String
Dim db As Database
Dim Lrs As DAO.Recordset
Dim LGST As String
Set db = CurrentDb()
Set Lrs = db.OpenRecordset("SELECT KEY FROM [Language Sample] where KEY='" & key & "' and English='" & english & "' and Language = '" & language & "'")
If Lrs.EOF = False Then
LGST = "Found"
Else
LGST = ""
End If
Lrs.Close
Set Lrs = Nothing
GetRecordsExist = LGST
End Function
In the Master table i have 15000 records and when its breaking 15000 records it becomes 15000 * 40 = 600000. above code inserting almost 10000 records per minutes and after few hour it' hangs up . But also it don't produce any error then i have to restart the access. Kindly help how can i do it in better way.
Alternative 1:
Use a large UNION query to append many records with one SQL statement, as described here:
How to simulate UNPIVOT in Access 2010?
You will probably want to split it into several chunks (e.g. 5 or 10 languages at a time), or Access might choke on the query.
Alternative 2:
Instead of running INSERT statements for each record, use a DAO recordset with .AddNew. This is faster by magnitudes, see this answer:
https://stackoverflow.com/a/33025620/3820271

Cannot use ListBox values in MS Access 2007 to pass to query

Good morning,
I am helping to develop an interface via a Form in MS Access. We have a list box with various user values and the user should be able to select multiple values in the ListBox and then press the button to execute a query, returning only the rows whose Car Name is what was selected.
UPDATE - thanks to some great feedback on this forum, the primary issue was resolved. My secondary issue is now not being able to execute the query. When I try, I get the error that the query cannot be executed.
My code (as event procedure) for the button is:
Option Explicit
Private Sub btnSearchCars_Click()
MsgBox "Starting Sub"
Call QueryCars.myQuery
MsgBox "Ending Sub"
End Sub
Then, my QueryCars module looks like this:
Sub myQuery()
Dim strWhere As String
Dim strSQL As String
Dim varItem As Variant
For Each varItem in Forms!FormSelect!listCarID.SelectedItems
strWhere = strWhere & "'" & Forms!FormSelect!listCarID.ItemData(varItem) & "',"
Next
strWhere = Left(strWhere, Len(strWhere) -1)
strSQL = "SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & strWhere & ");"
DoCmd.RunSQL strSQL
End Sub
My error is an "A RunSQL requires an argument of an SQL statement" error on the line.
DoCmd.RunSQL strSQL
I would really appreciate it if someone could help. All I am trying to do is take the values from the list box the user selects and use them as WHERE criteria in my query. I have searched various SO and Access forums all morning and have not found anything to help.
Thank you. Please let me know if you have any questions.
This isn't the perfect answer I was hoping to give you - but can't figure out how to use parameter queries in an IN command.
I'll assume that your listbox contains two columns of data and the CarID values are in the first column.
The main function is called ProcessQuery and accepts a reference to the listbox as an argument:
Public Sub ProcessQuery(myList As ListBox)
You can then call your code from the event on the listbox and pass it the listbox reference.
Private Sub btnSearchCars_Click()
ProcessQuery Me.listCarID
End Sub
The ProcessQuery procedure then looks at the first column to get the index numbers, constructs the SQL, opens the resulting recordset and pulls the info from each record.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
Set rst = qdf.OpenRecordset
'Move through the recordset and output the first two fields from each record
'to the Immediate window.
With rst
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
Debug.Print .Fields(0) & " - " & .Fields(1)
.MoveNext
Loop
End If
End With
End Sub
To display the query result as a datasheet you could use the following, but I'd prefer to use a stored query with a parameter for the IN. I'll try and figure that bit out.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("TempQDF", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
DoCmd.OpenQuery "TempQDF", acViewNormal
End Sub
I would suggest first taking a look at the actual WHERE clause being generated...keep a separate string variable to store it, and then dump it to the Immediate Window when it's generated.
I would also suggest creating a separate function to return values selected in a list box as an array. Something like:
Public Function getListBoxSelection(ctl As Access.ListBox) As Variant
Dim arr() As Variant
Dim varItem As Variant, i As Long
If ctl.ItemsSelected.Count > 0 Then
ReDim arr(0 To ctl.ItemsSelected.Count - 1)
i = 0
For Each varItem In ctl.ItemsSelected
arr(i) = ctl.ItemData(varItem)
i = i + 1
Next varItem
End If
getListBoxSelection = arr
End Function
Then, you would call it in SQL generation. Something like
whereClause = join(getListBoxSelection(me.listCarID), " AND ")
debug.Print whereClause
qdf.SQL = _
"select tblBig.* " & _
"from tblCars " & _
"inner join tblBig on tblCars.Cat_ID = tblBig.Car_ID " & _
"where tblCars.Card_ID in (" & whereClause & ")"

Error on a recordset, but same SQL works elsewhere

Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function

MS Access - How to split one large table into smaller tables by record count

I have a table in MS Access that has +17K of records. I am trying to break down that table into smaller tables of 500 records each. Using the following code, I am able to create the temp table, but I cannot reset the number of ID column. The ID column on the original table is an autonumber. I am trying to reset the ID field on the temp table so I can do a record search starting at 1 and going to 500.
The alter SQL that I have does not update/reset the temp table's ID column to 1. Any ideas?
Function SplitTables_Actual()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
SQL = "SELECT * INTO tmp_Flush_Actual FROM BIG_Table"
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Actual ALTER COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from BIG_Table"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 500 + 1
For i = 1 To tblcount
SQL = "SELECT * into tmp_flush_Actual" & i & " FROM tmp_Flush_Actual" & _
" WHERE ID <= 500*" & i
DoCmd.RunSQL SQL
SQL = "DELETE * FROM tmp_Flush_Actual" & _
" WHERE ID<= 500*" & i
DoCmd.RunSQL SQL
Next i
End Function
Bottom line, on the initial query, don't select the ID (Autonumber) column. Select the columns you want into the initial temp table, then alter the table to add a new counter column. I used COUNTER(1,1) so that each time the temp table is created, the first record is 1.
I added a little nugget that saves the broken files to a folder. I commented out the error handling, but uncomment it to make sure your save directory is working correctly.
Function SplitTables_RTPA_Actual()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
'Just don't select the ID column
SQL = "SELECT Company, Incurred_By, Transaction_Type, Format(Transaction_Date, 'mm/dd/yyyy'), Investment_ID, " & _
"Task_ID, Charge_Code, Resource_ID, Role, Notes, Quantity INTO tmp_Flush_Tran_Actual FROM Actual_Transaction_Data"
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual ADD COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from Actual_Transaction_Data"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 100 + 1
For i = 1 To tblcount
'Create Temp Flush File
SQL = "SELECT * into tmp_Flush_Tran_Actual" & i & " FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual" & i _
& " DROP COLUMN ID;"
DoCmd.RunSQL SQL
'Delete 500 from Temp Flush File
SQL = "DELETE * FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
'On Error GoTo ErrorHandler
Dim strTable As String
Dim strWorksheetPath As String
'Location where you want to save the broken out files
strWorksheetPath = "C:\YOUR TEMP FOLDER\TEST\"
strWorksheetPath = strWorksheetPath & "Actual_Transactions" & i & ".xls"
strTable = "tmp_Flush_Tran_Actual" & i
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel9, TableName:=strTable, FileName:=strWorksheetPath, hasfieldnames:=True
'ErrorHandlerExit:
' Exit Function
' 'Next i
'
'ErrorHandler:
' MsgBox "Error No: " & Err.Number _
' & "; Description: " & Err.Description
' Resume ErrorHandlerExit
Next i
End Function

Looping through an array and posting array to table

I am an old Foxpro programmer and I use to use arrays to post variable fields.
What I am trying to do is I have 15 date fields in the new table I designed.
In my query I have individual records with one date for activity.
I want to compile the 15 different dates for a each Client_id into one record with 15 dates but I can't seem to reference the table data as an array.
I have tried a couple different methods of defining the array but nothing seems to work.
Here is my code that I have. In my table I have 15 date fields named Mail_date1, Mail_date2, Mail_date3, etc.
I tried first defining it just as an array but did not like it; my code always fails when I try to reference the date field in the result table rs2!mdate2 = memdate(intcounter)
How can I reference my result table output fields as an array?
Do I have to put a whole bunch of if statements to load my results?
Seems like a waste.... should be able to load them as an array.
I am a new Access 2007 VBA programmer.
Dim db As DAO.Database
Set db = CurrentDb
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim FinTotal, intcounter As Integer
Dim FinMPU, FinVersion As String
Dim mail_date(1 To 15) As Date
Dim memdate(1 To 15) As Date
Dim mdate2 As String
Set rs1 = db.OpenRecordset( _
"SELECT NewFile.MPU_ID, " & _
" NewFile.MAIL_DATE," & _
" NewFile.TOTAL, " & _
" Freight.Version " &_
"FROM Freight " & _
" LEFT JOIN NewFile ON Freight.[MPU ID] = NewFile.MPU_ID " & _
"ORDER BY NewFile.MPU_ID, NewFile.MAIL_DATE")
Set rs2 = db.OpenRecordset("Final")
DoCmd.RunSQL "DELETE Final.* FROM Final;"
intcounter = 1
memdate(intcounter) = rs1!mail_date
FinMPU = rs1!mpu_ID
FinTotal = rs1!total
FinVersion = rs1!Version
rs1.MoveNext
On Error GoTo Error_MayCauseAnError
Do While Not rs1.EOF
Do While Not rs1.EOF _
And memdate(intcounter) <> rs1!mail_date _
And FinMPU = rs1!mpu_ID
intcounter = intcounter + 1
memdate(intcounter) = rs1!mail_date
FinTotal = FinTotal + rs1!total
FinVersion = rs1!Version
FinMPU = rs1!mpu_ID
rs1.MoveNext
Loop
If FinMPU <> rs1!mpu_ID Then
rs2.AddNew
mdate2 = "mail_date" & CStr(intcounter)
rs2!mdate2 = memdate(intcounter)
rs2!total = FinTotal
rs2!mpu_ID = FinMPU
rs2!Version = FinVersion
rs2.Update
FinTotal = rs1!total
FinVersion = rs1!Version
FinMPU = rs1!mpu_ID
intcounter = 1
memdate(intcounter) = rs1!mail_date
End If
rs1.MoveNext
Loop
first, if you expect and answer, you should really spend more time on properly formatting your explanation and your code...
Now, for some remarks and possible answer to the question:
You should DELETE FROM Final before you open that table in a recordset.
You should be explicit about the type of recordset you are opening:
' Open as Read-only '
Set rs1 = db.OpenRecordSet("...", dbOpenSnapshot)
' Open as Read/Write '
Set rs1 = db.OpenRecordSet("...", dbOpenDynaset)
You should Dim memdate(1 To 15) As Variant instead of Date as the Date datatype cannot be Null, and since you are pulling data from a LEFT JOIN, it's possible that the returned values could be Null if there are no corresponding data to Freight in the table Newfile.
That On Error GoTo Error_MayCauseAnError should probably not be there.
Use On Error Goto only to catch errors you can't deal with at all.
Using that here will only hide errors in your code. With some proper checks statements you should not even need the On Error Goto...
It looks like your first internal loop is trying to skip some records.
However, when that loop breaks, it could be because it reached EOF, and you never test for that in the code that follows the loop.
You never test if your intcounter goes beyond the 15 allocated dates.
Are you absolutely sure that you can never have more than 15 records?
You do not say which error message you get exactly. That could be useful to help determine the kind of issue at hand.
Instead of
mdate2 = "mail_date" & CStr(intcounter)
rs2!mdate2 = memdate(intcounter)
Use
rs2.Fields("mail_date" & intcounter).Value = memdate(intcounter)
the ! syntax of DAO really only is a shorthand for the longer rs.Fields("name") form.