Getting "The error 3061, Too few paramaters. Expected 6" (1 Viewer)

[chuckcoleman]

Hi, I have a relatively simple vba code but it generates the above code. I believe the problem is on the line that begins: Set rs = CurrendDb.OpenRecordset("Temp Daily Table Query for Form")

What am I doing wrong?

Chuck

Private Sub SendEmailsX_Click()
 On Local Error GoTo SendEmailsX_Error
    
    Dim olApp As Object
    Dim olMail As Object
    Dim rs As DAO.Recordset
    Dim EmailList As String

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    Set rs = CurrentDb.OpenRecordset("Temp Daily Table Query for Form")
        
    Do While Not rs.EOF
     olMail.To = rs!Email
     olMail.Subject = "Your XYZ appointment"
     olMail.BodyFormat = olFormatHTML
     olMail.HTMLBody = "Hi, we're coming to your home."
     olMail.Display
     rs.MoveNext
    Loop
    
    olApp.Quit
    
SendEmailsX_Resume:
    Exit Sub
SendEmailsX_Error:
    MsgBox "Sprinkle, the Error (" & CStr(Err.Number) & ") " & Err.Description, _
        vbExclamation, "Error!"
        Resume SendEmailsX_Resume
 
End Sub

 

[Minty]

A VBA recordset can't always evaluate form references, if that is what is in your saved query as Criteria.
Either that or the form isn't open that drives it.

 

[chuckcoleman]

Thanks Minty. The query does have criteria that is based on an open form. The form is open. If the form has data that is significant to the query, what is your suggestion to overcome this?

 

[theDBguy]

Hi. See if you can use this generic recordset.

Code Snippets

 

[Pat Hartman]

When you execute a query that takes parameters, you must provide the values before you run the query. For example:

    Set qd = db.QueryDefs!q837P_AppendBatch
        qd.Parameters!EnterMinSelDT = Me.txtMinSelDT
        qd.Parameters!EnterMaxSelDT = Me.txtMaxSelDT
        qd.Parameters!EnterBatchID = Me.txtBatchID
        qd.Parameters!EnterBatchYY = Me.txtBatchYY
        qd.Parameters!EnterBatchMM = Me.txtBatchMM
        qd.Parameters!EnterBatchSeq = Me.txtBatchSeq
        qd.Parameters!EnterClientID = Me.cboClientID
        qd.Parameters!EnterProcedureID = Me.cboProcedureID
        qd.Parameters!EnterProviderID = Me.cboProviderID
    qd.Execute (dbSeeChanges)
    
    .......
    
        Set qd = db.QueryDefs!q837P
        qd.Parameters!EnterTransmittal = Me.TransmittalNum
        qd.Parameters!EnterBatchID = Me.txtBatchID
    Set rsIN = qd.OpenRecordset(dbOpenDynaset, dbSeeChanges)

 

[CJ_London]

I use a slightly shorter method for populating form based parameters. This example opens a recordset, but could use .execute for an action query. Clearly, the form needs to be open when the code is run

Set db = CurrentDb
        With db.QueryDefs("QueryName")
        
            For i = 0 To .Parameters.Count - 1
                .Parameters(i) = Eval("" & .Parameters(i).Name)
            Next i
            
            Set rs = .OpenRecordset
            
        End With

 

[chuckcoleman]

This is a continuation of my original thread. I overcame the problem by having the Query do a Make Table and then using that as the "query". The issue I'm now having is that when I have Outlook .Send the emails, (my table only includes three records), it only sends an email to the first record and I then get the message, "The error (-2147221238) The item has been moved or deleted." What's weird about this is if I change .Send to .Display I see all three emails but after I closed the last email, I get the same error. The MsgBox accurately displays the right number of messages which is 3. I don't understand why I'm getting the error because at the beginning of the loop it says do this if not at end of file for the record set. What am I doing wrong?

Private Sub SendEmailsX_Click()
 On Local Error GoTo SendEmailsX_Error
    
    Dim olApp As Object
    Dim olMail As Object
    Dim rs As DAO.Recordset
    Dim EmailList As String
    Dim Subj As String
    Dim Bdy As String
    Dim LngCount As Long
    Dim lngRSCount As Long
    Dim lngRecordPosition As Long
    
    Subj = "Your appointment today"
    Bdy = "Hi, we're going to be at your home"

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    Set rs = CurrentDb.OpenRecordset("Temp Daily Table Query for Form Test")
    lngRSCount = rs.RecordCount
    MsgBox ("1-The number of records in the table is: " & lngRSCount)
    If Not rs.EOF Then
     rs.MoveLast ' Move to the last record
     rs.MoveFirst ' Move back to the first record
    End If
    
    Do While Not rs.EOF
     olMail.To = rs!EmailX
     olMail.Subject = Subj
     olMail.HTMLBody = Bdy
    ' olMail.Display
     olMail.Send
     rs.MoveNext
    Loop
    
    olApp.Quit
    
    
SendEmailsX_Resume:
    Exit Sub
SendEmailsX_Error:
    MsgBox "Sprinkle, the Error (" & CStr(Err.Number) & ") " & Err.Description, _
        vbExclamation, "Error!"
        Resume SendEmailsX_Resume
 
End Sub

 

[theDBguy]

Which line is highlighted when you go to Debug mode?

 

[chuckcoleman]

I'm sure I'm doing something wrong, but there isn't any highlighted line in the Debug mode.

 

[theDBguy]

I'm sure I'm doing something wrong, but there isn't any highlighted line in the Debug mode.

You might consider posting a sample db to illustrate the problem.

 

[Pat Hartman]

I overcame the problem by having the Query do a Make Table and then using that as the "query".

Wrong solution. temp tables cause bloat. Now that you know how to populate parameters, you might want to switch back.

I'm sure I'm doing something wrong, but there isn't any highlighted line in the Debug mode.

Have you set a breakpoint so you can step through the code to see where it fails?

 

[chuckcoleman]

Hi Pat. Again, maybe I'm doing something wrong. In the VBA editor I clicked on the line olApp.Quit and went to Debug, Toggle Breakpoint. It highlighted that line and put a dot to the left of that line. I then use F8 or Debug, Step Into or Debug, Run to Cursor and nothing happens.

 

[chuckcoleman]

After toggling a breakpoint if I type the procedure name in the Immediate Window, SendEmailsX_Click, I get, "Compile error: Expected procedure, not variable". However when I compile the code I don't get any errors.

 

[Gasman]

Surely you need to create a new email within the recordset loop?

  Do While Not rs.EOF
        ' Set flag and field to check
        blnSameClientType = True
        strClientType = rs!Client & rs!TranType
        strType = rs!TranType
        
        ' Create the message if first time we are in a different client or tran type.
         Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")
        With objOutlookMsg
            ' Set the category
            .Categories = "SSAFA"
            .Importance = olImportanceHigh
            ' Add the To recipient(s) to the message. (Also work out which account to send on 12/07/19)
            If rs!ClientDivision = "SSW" Then
                Set objOutlookRecip = .Recipients.Add("Jim Needs - Personal")
                objOutlookRecip.Type = olTo
                intAccount = 2
            Else
                Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                objOutlookRecip.Type = olTo
                intAccount = 3
            End If
            ' Add the CC recipient(s) to the message.
            If rs!CCOffice And rs!ClientDivision = "SSW" Then
                Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                objOutlookRecip.Type = olCC
            End If
            
            ' Need to get the Case Worker name from table, might be deactivated, so not in recordset
            If rs!CaseWorker > 0 Then
                rsCW.FindFirst "[ID] = " & rs!CaseWorker
                If rsCW.NoMatch Then
                    strCaseWorker = ""
                Else
                    strCaseWorker = rsCW!Data
                End If
            Else
                strCaseWorker = ""
            End If

            If strCaseWorker <> "" Then
                Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                objOutlookRecip.Type = olCC
            End If
            
            ' Add Glyn in as BCC for CMS update - 12/02/19
            ' Only if SSW and he is not the caseworker
            If rs!ClientDivision = "SSW" And strCaseWorker <> "Glyn Davies" Then
                Set objOutlookRecip = .Recipients.Add("Glyn Davies")
                objOutlookRecip.Type = olBCC
            End If

            
            ' Set the Format, Subject, Body, and Importance of the message.
            '.BodyFormat = olFormatHTML
            strClient = rs!Client


            If strType = "Payment" Then
                .Subject = " Payment Made - " & strClient
            Else
                .Subject = "Deposit Received - " & strClient
            End If
            ' Now start the email with header
            'iColon = InStr(strClient, ":")
            ' If iColon = 0 Then iColon = Len(strClient) + 1
            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"
            '    .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
            'End If
            ' Set counter to zero for count of transactions
            intTransactions = 0
        End With

        Do While blnSameClientType
            strDate = rs!TransactionDate
            strType = rs!TranType
            str3rdParty = rs!ThirdParty
            strAmount = Format(rs!Amount, "Currency")
            'strBalance = Format(rs!Balance, "Currency")
            'strBalance = Format(DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            ' Now using unique key Ukey to get correct running balance for entries out of sequence
            dblBalance = DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND format(TransactionDate,'yyyymmdd')& format(ID,'000000') <= '" & rs!Ukey & "'")
            strBalance = Format(dblBalance, "Currency")
            ' Missed in sequence dates was producing erroneous balances 240620
            'strBalance = Format(Nz(DSum("Amount", "Emails", "CMS = " & [CMS] & " AND ID <=" & [ID]), 0), "Currency")
            'Now Calculated on the fly
            'strBalance = Format(rs!Balance, "Currency") ' was Format(DSum("[Amount]", "Emails", "[CMS]=" & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            
            ' Make strBalance Red if negative
            If dblBalance < 0 Then
                strBalance = "<font color=""Red"">" & strBalance & "</font>"
            End If
            
            strRef = rs!Reference
            strMethod = rs!Method
            
            'strDatetype = "Date "
            If strType = "Payment" Then
                str3rdPartyType = "Recipient:"
                strDatetype = "Date Paid:"
            Else
                str3rdPartyType = "From Donor:"
                strDatetype = "Received:"
            End If

            strNotes = Nz(rs!Notes, "")
        
        
            ' Now build the body of the message
            
            ' Make sure we have a colon in client, else use whole field
            
            ' Now add the variable data
            With objOutlookMsg
                .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
                .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Method:" & strPadCol & strMethod & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Reference:" & strPadCol & strRef & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Amount:" & strPadCol & strAmount & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Balance:" & strPadCol & strBalance & strEndPad
                ' Add any notes if they exist
                If Len(strNotes) > 0 Then
                    .HTMLBody = .HTMLBody & strPad & "Notes:" & strPadCol & strNotes & strEndPad

                End If
'                ' Add blank line for next set
                .HTMLBody = .HTMLBody & strBlankLine & strBlankLine
            End With
            
            'Now update the record
            rs.Edit
            rs!EmailStatus = "Sent"
            rs!EmailDate = Date
            rs.Update

            ' Now get next record
            rs.MoveNext
            ' Has client or tran type changed?
            If Not rs.EOF Then
                If strClientType = rs!Client & rs!TranType Then
                    blnSameClientType = True
                Else
                    blnSameClientType = False
                End If
            Else
                blnSameClientType = False
            End If
            ' Increment the counter
            intTransactions = intTransactions + 1
        Loop                                     ' End blnClientType loop
        
        ' Now add the footer and amend subject to indicate how many transactions in email
        With objOutlookMsg
            .Subject = .Subject & " - " & intTransactions & " " & strType
            If intTransactions > 1 Then
                .Subject = .Subject & "s"
            End If
            
            ' Need to amend the footer depending on account being used intAccount = 2 = SSW, 3 is NPT
            If intAccount = 3 Then
                strFooter = Replace(strFooter, "Divisional Treasurer, Swansea South &amp; West", "Temporary Divisional Treasurer, Neath &amp; Port Talbot")
            End If
            
            ' Now add the footer
            .HTMLBody = .HTMLBody & "</table>" & strFooter
            '.Importance = olImportanceHigh  'High importance
            'Debug.Print strHeader
            'Debug.Print .htmlbody
            'Debug.Print strFooter
            ' Resolve each Recipient's name.
            For Each objOutlookRecip In .Recipients
                'Debug.Print objOutlookRecip.Name
                objOutlookRecip.Resolve
            Next
    
            ' Should we display the message before sending?
            .SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)
            If blnDisplayMsg Then
                .Display
            Else
                .Save
                .Send
            End If
        End With
    
            
    Loop

 

[Pat Hartman]

Put your breakpoint on this line:

Subj = "Your appointment today"

you need to stop the code at the beginning and step through it. Putting the break at the end doesn't help you to see what is going on.

 

[chuckcoleman]

Pat, I put it on the Subj line and set the breakpoint there. I hit F8 and I also clicked on Debug, Run to Cursor or Debug, Step Into. Nothing happens. I'm sure this is 100% pilot error but nothing happens.

Gasman, by having Do While Not rs.EOF, olMail.To = rs.EmailX, olMail.Send and rs.MoveNext, aren't I creating the first email, (which it does), but I'm not getting any more emails. I thought the rs.MoveNext would take care of that?

 

[Gasman]

Pat, I put it on the Subj line and set the breakpoint there. I hit F8 and I also clicked on Debug, Run to Cursor or Debug, Step Into. Nothing happens. I'm sure this is 100% pilot error but nothing happens.

Gasman, by having Do While Not rs.EOF, olMail.To = rs.EmailX, olMail.Send and rs.MoveNext, aren't I creating the first email, (which it does), but I'm not getting any more emails. I thought the rs.MoveNext would take care of that?

No!, look at my code. You need to create an email each time. It is a fresh email.
Perhaps that is why it is saying it is not there, as you create one, send, then there is nothing to populate with the next record.

Leastways that is the way I have always done it?

Look at the OMail object in the Locals window. Is it there, does it have any properties?

 

[Minty]

Agree with @Gasman .
Your olMail object is a single email, you need to create a new one for each run through the loop.

 

[Pat Hartman]

There seems to be two problems.
1. you can't get the debug process to work
2. your code isn't correct anyway.

Start with trying to fix your code. I have not looked at this closely but it might be as simple as putting

Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)

inside the loop instead of outside it.

If that doesn't work, try using Gasman's code and modifying it.

 

[Gasman]

No, do not put the create object of the app in the loop, just the mailitem.
I just copied a block of code I used to use, so just look at the logic and where I create a new email each time.
In that code I might have more than one record's data added to an email for a client.