docmd.SendObject but with filter (1 Viewer)

[GBalcom]

Hi Guys, I'm having some trouble piecing together some code. Below is my purpose:

We send monthly reports to each sales rep. These reports need to be in an excel spreadsheet, and the data specific to each sales rep. I want to be able to send this automatically out of access to each sales rep.

I'm running into two roadblocks with docmd.sendobject.
1. It doesn't allow for a way to filter the query before sending (to show only each sales rep)

2. It doesn't allow for an sql query.

the SQL query looks promising, but I can't seem to find a way to send it without saving it as a file first (can do if necessary, but It has no value)

Please see code below:

Private Sub CmdSendExcelTable_Click()


On Error GoTo Error_Handler

   Dim db As DAO.Database
   Dim rs As DAO.Recordset  'to hold the Sales Rep ID's
   Dim strSQL As String     'holds new query definition
   Dim strContactID As String 'same as above
   Dim strTo As String
   Dim strCC As String
   Dim strBody As String
   Dim strSubject As String
   Dim qdf As DAO.QueryDef
        

'set email string information
    strCC = "EMAIL"
    strBody = "Please Look into the attached Quotes. Clarify their status on the Excel document and send back.  Thanks!"
    strSubject = "Aging Quotes"
    
    
    
    
    
   Set db = CurrentDb
   Set rs = db.OpenRecordset("qrySalesReps")
   
   
   'set query def
   Set qdf = db.QueryDefs("qrySalesDataReport")
   
        With rs
            'Perform Function
            Do Until .EOF
             .MoveFirst
                'set Value to use in Query
                strContactID = .Fields("SalesRepID").Value
                
                strSQL = qdf.SQL
                Debug.Print strSQL
                
                strSQL = Replace(strSQL, "ReplaceSalesRep", strContactID)
                Debug.Print strSQL
                
                '_____ORIGINAL THOUGHT PATH_____CHANGE A PARAMETER IN QUERY
                'set parameter in query
                'qdf.Parameters("SalesRepContactID").Value = strContactID
                
                'set Send To
                strTo = DLookup("Email", "tblSalesRepInfo", "SalesRepID = '" & strContactID & "'")
                
                
                'send stuff
                On Error Resume Next
                DoCmd.SendObject acSendQuery, , acFormatXLS, strTo, strCC, , strSubject, strBody
                
             .MoveNext
            Loop
            
            
    
                
        End With







Exit_Procedure:
    Set rs = Nothing
    Set db = Nothing
    On Error Resume Next
    Exit Sub

    
Error_Handler:
    DisplayErr Err.Number, Err.Description, "frmRunReport", "GetSalesRepID()"
    Resume Exit_Procedure
    Resume
End Sub

Thanks for any insight!

 

[pbaldy]

Untested, but you can try having the query point to a form textbox for its criteria, and update that textbox in your loop.

 

[GBalcom]

Thanks PBaldy,
I got it to work without a textbox! After some monday morning debugging, I found that my loop statement wasn't working correctly...after fixing that, it works great! see final code below if interested....hopefully it will help someone else.

Private Sub CmdSendExcelTable_Click()


On Error GoTo Error_Handler

   Dim db As DAO.Database
   Dim rs As DAO.Recordset  'to hold the Sales Rep ID's
   Dim strSQL As String     'holds new query definition
   Dim strContactID As String 'same as above
   Dim strTo As String
   Dim strCC As String
   Dim strBody As String
   Dim strSubject As String
   Dim qdf As DAO.QueryDef
   Dim strLastContactID As String

'set email string information
    strCC = "email"
    strBody = "Please Look into the attached Quotes. Clarify their status on the Excel document and send back.  Thanks!"
    strSubject = "Aging Quotes"
    
    
    
    
    
   Set db = CurrentDb
   Set rs = db.OpenRecordset("qrySalesReps")
   
   
   'set query def
   Set qdf = db.QueryDefs("qrySalesDataReport")
   
        With rs
            'Perform Function
            ''.MoveLast
            ''Debug.Print .RecordCount
            .MoveFirst
            strLastContactID = "005"
            Do Until .EOF

            
             
                'set Value to use in Query
                strContactID = .Fields("SalesRepID").Value
                Debug.Print strContactID
                
                strSQL = qdf.SQL
                Debug.Print strSQL
                
                strSQL = Replace(strSQL, strLastContactID, strContactID)
                Debug.Print strSQL
                
                'reset query definition to match this contactID
                qdf.SQL = strSQL
                
                
                'set Send To
                strTo = Nz(DLookup("Email", "tblSalesRepInfo", "SalesRepID = '" & strContactID & "'"), "")
                
                
                'send stuff
                On Error Resume Next
               DoCmd.SendObject acSendQuery, "qrySalesDataReport", acFormatXLS, strTo, strCC, , strSubject, strBody
                
                'set variable which allows for text replacement in the next loop
                strLastContactID = strContactID
                
             .MoveNext
                
            Loop
            
            strLastContactID = "005"
            
            'reset query def for next use
            
            strSQL = Replace(strSQL, strContactID, strLastContactID)
                Debug.Print strSQL
                
                qdf.SQL = strSQL
    
                
        End With
        
MsgBox "Emailing Complete!"







Exit_Procedure:
    Set rs = Nothing
    Set db = Nothing
    On Error Resume Next
    Exit Sub

    
Error_Handler:
    DisplayErr Err.Number, Err.Description, "frmRunReport", "GetSalesRepID()"
    Resume Exit_Procedure
    Resume
End Sub

 

[LukeChung-FMS]

There are a lot of limitations to the DoCmd.SendObject command. Here's our paper: DoCmd SendObject Command in Microsoft Access: Features and Limitations for Sending Emails

If you're interested in a commercial solution that will automatically email personalized messages with filtered attachments (spreadsheets, PDF, etc.), check out our Total Access Emailer addin program. It'll let you do these things without any programming. The Professional Version has a programmatic VBA interface and runtime library if you want to automate it.

Hope this helps.

 

[GBalcom]

Thanks Luke, but the programming I have above is working well for me. I've looked at your products for a while now. I like the idea of a lot of them, but haven't had the budget to purchase....

 

[LukeChung-FMS]

GBalcom,

No problem. We're aware that not every organization invests in developer tools for their Access developers unlike what they do for other programming professionals. That's unfortunate for all of us.

Also too bad you're stuck in Access 2003. With Access 2007 or 2010 (and distributing with the free Runtime), you can easily create emails that attach PDF files from your reports. That's really nice and lets you extend Access apps to the outside world in a standardized way.

All the best.

 

[thechazm]

... When did posting for help in a forum turn into an advertisement board :/ People need to learn to work through their problems and this is a great resource for learning so please post your advertisements in the proper area's like small business or whatever. Thanks

 

[serviciosdesistemas]

Thanks PBaldy,
I got it to work without a textbox! After some monday morning debugging, I found that my loop statement wasn't working correctly...after fixing that, it works great! see final code below if interested....hopefully it will help someone else.

Private Sub CmdSendExcelTable_Click()


On Error GoTo Error_Handler

   Dim db As DAO.Database
   Dim rs As DAO.Recordset  'to hold the Sales Rep ID's
   Dim strSQL As String     'holds new query definition
   Dim strContactID As String 'same as above
   Dim strTo As String
   Dim strCC As String
   Dim strBody As String
   Dim strSubject As String
   Dim qdf As DAO.QueryDef
   Dim strLastContactID As String

'set email string information
    strCC = "email"
    strBody = "Please Look into the attached Quotes. Clarify their status on the Excel document and send back.  Thanks!"
    strSubject = "Aging Quotes"
   
   
   
   
   
   Set db = CurrentDb
   Set rs = db.OpenRecordset("qrySalesReps")
  
  
   'set query def
   Set qdf = db.QueryDefs("qrySalesDataReport")
  
        With rs
            'Perform Function
            ''.MoveLast
            ''Debug.Print .RecordCount
            .MoveFirst
            strLastContactID = "005"
            Do Until .EOF

           
            
                'set Value to use in Query
                strContactID = .Fields("SalesRepID").Value
                Debug.Print strContactID
               
                strSQL = qdf.SQL
                Debug.Print strSQL
               
                strSQL = Replace(strSQL, strLastContactID, strContactID)
                Debug.Print strSQL
               
                'reset query definition to match this contactID
                qdf.SQL = strSQL
               
               
                'set Send To
                strTo = Nz(DLookup("Email", "tblSalesRepInfo", "SalesRepID = '" & strContactID & "'"), "")
               
               
                'send stuff
                On Error Resume Next
               DoCmd.SendObject acSendQuery, "qrySalesDataReport", acFormatXLS, strTo, strCC, , strSubject, strBody
               
                'set variable which allows for text replacement in the next loop
                strLastContactID = strContactID
               
             .MoveNext
               
            Loop
           
            strLastContactID = "005"
           
            'reset query def for next use
           
            strSQL = Replace(strSQL, strContactID, strLastContactID)
                Debug.Print strSQL
               
                qdf.SQL = strSQL
   
               
        End With
       
MsgBox "Emailing Complete!"







Exit_Procedure:
    Set rs = Nothing
    Set db = Nothing
    On Error Resume Next
    Exit Sub

   
Error_Handler:
    DisplayErr Err.Number, Err.Description, "frmRunReport", "GetSalesRepID()"
    Resume Exit_Procedure
    Resume
End Sub

Gbalcon, I am new in this post, but today I have found the solution of my issue. This code is wonderfull, Thanks so much. I send a Hug.

 

[GBalcom]

Gbalcon, I am new in this post, but today I have found the solution of my issue. This code is wonderfull, Thanks so much. I send a Hug.

Haha! I wrote that?!? Seems like a lifetime ago. LOL The funny thing with VBA in the past few years is I always seem to be re-learning it. I'll have to dig in real deep for a few months, then not touch it again for a year or more. Glad it helped you out!!