Copy & Rename a report

[pbaldy]

Can you post the db, or a representative sample?

[Juanna_v]

Here it is. Thanks. I'm a bit desperate now. No matter what I try to do It always stops somewhere

[pbaldy]

Okay, try this. Note that I'm not a fan of creating/deleting objects all the time, so I created a dummy query named "q_temp" that will remain in the database and be reused (you need to create this). You can put that other stuff back if you want. This created two emails and left them open for editing. It's not done, but it's working, so you can smooth out the wrinkles:

  Dim qdf As DAO.QueryDef
  Dim dbs As DAO.Database
  Dim rstMgr As DAO.Recordset
  Dim strSQL As String, strTemp As String, strMgr As String
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim DisplayMsg As Boolean
  Dim varTo As Variant
  Dim stWhere As String

  On Error GoTo Err_SendMessage

  Const strQName As String = "zExportQuery"

  Set dbs = CurrentDb
  Set qdf = dbs.QueryDefs("q_temp")

  strSQL = "SELECT DISTINCT ManagerID, ManagerEmail FROM EmployeesTable;"
  Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

  Do While rstMgr.EOF = False

    strMgr = DLookup("ManagerID", "ManagersTable", _
                     "ManagerID = " & rstMgr!ManagerID.Value)

    strSQL = "SELECT * FROM EmployeesTable WHERE " & _
             "ManagerID = " & rstMgr!ManagerID.Value & ";"


    qdf.SQL = strSQL
    qdf.Close
    ' Replace C:\FolderName\ with actual path
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                              "q_temp", "C:\AccessAp\" & strMgr & Format(Now(), _
                                                                         "ddMMMyyy_hhnn") & ".xls"

    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")

    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg
      ' Set the Subject, Body, and Importance of the message.
      .Subject = "Subject"
      .Body = "Message"
      .To = rstMgr!ManagerEmail
      '.Importance = olImportanceHigh 'High importance

      Set objOutlookAttach = .Attachments.Add("C:\AccessAp\" & strMgr & Format(Now(), _
                                                                               "ddMMMyyy_hhnn") & ".xls")
      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
        objOutlookRecip.Resolve
      Next

      .Display

    End With

    rstMgr.MoveNext
  Loop

Exit_SendMessage:

  Set qdf = Nothing
  Set objOutlook = Nothing
  rstMgr.Close
  Set rstMgr = Nothing
  dbs.Close
  Set dbs = Nothing
  Exit Sub

Err_SendMessage:
  MsgBox Error$
  Resume Exit_SendMessage

[Juanna_v]

Thank u very much! You've been so much helpful. Still I can not try the code since I don't have outlook at home and have to wait until tomorrow so I can test. For the moment the only error that comes up is an outlook app error so I guess that everything else is ok. I'll know for sure tomorrow. Once again thank you very much for your assistance and for your time spend on this.

[pbaldy]

Happy to help! It would error since you don't have Outlook, as there's a reference set to Outlook. Try it tomorrow, and see what still needs tweaking.

[Juanna_v]

Well, how many thanks can i say for this!!! It works perfect. Exactly what I was looking for. Two more things if you can assist me also. How can I write in the body msg a text that I keep in a txtBox on a form named lets say "FrmMessage1").

and the 2nd one request is minor but I would appreciate if you could reply on this also. When I run the code all emails I have to send open the same time so I have to handle with many emails. Is it possible for the code to wait until I send the first email and then the 2nd appear ?

[pbaldy]

Glad it's working for you. For the first, this type of thing:

.Body = Forms!FormName.TextboxName

It would probably be more common to just send them all out with

.Send

instead of

.Display

I'm not sure how to wait for the user to actually send the email offhand. You could put a message box in after the .Display, which would stop the code until the user responded it.

[Juanna_v]

Hi again. I think that the solution for a yes/no msg box is will do my work.

Do you think the following syntax is ok? Unfortunately since I don't have outlook I cannot test the whole procedure.
----------
.Display
Dim Response As Integer
Response = MsgBox(prompt:="To continue press 'Yes' For exit 'No'.", Buttons:=vbYesNo)
' if user selects yes, i would like to macro to continue running
If Response = vbYes Then
Resume
Else
' if the user selects no, I would like the macro to stop and the user be returned to the main form

End If

End With

rstMgr.MoveNext
Loop

[pbaldy]

You don't need to specify "Resume", as code will continue unless instructed otherwise. Try:

If Response = vbNo Then
  GoTo Exit_SendMessage
End If

If they answer yes, code will continue on. You don't want to just exit the sub, you want to go to the exit point so all your variables get cleaned up.

[Juanna_v]

What can I say? So many many thanks! i Forgot to mention that I loved your suggestion to have a permanent query in the DB instead of deleting it all he time. RESPECT!!!

[pbaldy]

LOL! Glad we got it working for you.