Copy & Rename a report

[Juanna_v]

Hi all. Pls I need your help in this:



I use the following code to copy and paste an existing report with a new name.
DoCmd.CopyObject , "rpt2216", acReport, "rptMainReport"

But since I have to copy my mainreport to many many others I need to create a pop up message asking me something like this "Please provide a name for ur report" and name my report by the value I give. Can you please advice me on how I can do this?

Your replies would really appreciated. Thank you

[pbaldy]

Why do you need so many copies of the report? I ask because it implies you might not be doing things in the most efficient manner. Typically you'd have one report and you'd filter it as needed.

[Juanna_v]

Firstly thank you very much for your reply. Now for ur question. My project is a bit complicated. I have a list of Branches. For each branch I need to create a report and email it to it's owner. My idea was to have a main report based on a query and for each branch copy the report and give it the name of the branch and then email it. Am I close ?

[pbaldy]

That's what I was afraid of. Your solution would be the "brute force" method. The elegant method is to have one report and filter/email it to each branch. Here's a start:

http://www.granite.ab.ca/access/emai...recipients.htm

Basically you have one report that filters itself based on a form control or global variable. You have a loop of all branches that sets that form control or global variable to the current branch, then sends the report.

[Juanna_v]

The "elegant solution" was my first thought but although I searched a lot I could only solve the half part of it.
See, my problem is that I don't want to send an email to everyone in my list. I have an empty column where for each branch I need to send an mail I write "send" for all others I write "checked". After searching I found the code that is pretty close to what I want but it only solves half of my issue. You see, the code only exports the selected branches to separate xls files and names them accordingly, which is fine for me, but I couldn't find out how to send it by email automatically by picking the recipient from column "email_recepient".

My second thought was the one I asked above.

I would really appreciate any solution eirther to first or the second approach to my problem.

Thanks

[pbaldy]

The first problem should be solvable by using a query that only selects the appropriate branches. The code I posted would send the email, but if you want to post the code you found we'll figure out how to add the email bit.

[Juanna_v]

Here is the code i've found, which is quite good, but when i'm getting to the emailing part i'm totally lost

Private Sub Command0_Click()
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

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "D:\audit\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls"
rstMgr.MoveNext
Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

End Sub

[pbaldy]

If you want to keep the exported Excel files, stay with that and add this type of code to send the file as an attachment:

http://support.microsoft.com/?kbid=161088

If you don't care about saving the file, you can replace the DoCmd.TransferSpreadsheet line with DoCmd.SendObject with the appropriate arguments.

[Juanna_v]

hi! Thank u very much for ur help. I'll try it at work since I can't send emails through outlook at home.

Just a small clarification. At the line where I put the recipient :
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")

I want the code to look at a specific column and automatically gets the manager email of each branch. Does this line above do what I want or should I need to make changes? If I need to change something I would appreciate it if you could tell me how to do it.

Again thanks for your time.

[pbaldy]

I assume it's a field in the recordset, so:

Set objOutlookRecip = .Recipients.Add(rstMgr!EmailAddressField)

[Juanna_v]

Thanks. I'll test all of it later at work. One more question. When trying to run the email code I got an error msg that "DisplaMsg Variable not defined" so I add at the beginning Dim DisplayMsg As String. You think it's correct?

[pbaldy]

If it's from the link I posted, it's "DisplayMsg" and it was one of the input parameters:

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)

[Juanna_v]

Below is my try in total. When I added the line Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath), I get an error message that : End Sub Expected. Can u please advice me in this also? Seems that I'm really close to an end


Private Sub Command0_Click()
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

Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "F:\DAILY AUDIT ACCESS PROJECT\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls"

rstMgr.MoveNext



' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(rstMgr!ManagerID)
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing("F:\DAILY AUDIT ACCESS PROJECT\") Then
Set objOutlookAttach = .Attachments.Add("F:\DAILY AUDIT ACCESS PROJECT\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls")
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)


If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End Sub
End With

Set objOutlook = Nothing

Loop

End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Sub

[pbaldy]

Well, you can do one of two things. That code as shown on the link is a stand alone procedure that your original procedure would call out to. The other option is to incorporate the code into your original procedure, which you appear to have done. What you can't have is one procedure inside another, which is what you've got. Given all the work you did to incorporate it into your procedure, I'd just get rid of the Sub and End Sub lines in the middle, and deal separately with that variable. Since you're not using the procedure as a stand alone, you can get rid of the test and either display or send, as desired.

[Juanna_v]

After the changes you suggested to me I resulted to the following, but now I get an error message where my recipient list should be. The error message says: object variable or with block variable is not set

What I want is my code looking at the query and from field ManagerEmail get the appropriate value for each field. What should I do ?

Private Sub Command0_Click()
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

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names

strMgr = DLookup("ManagerID", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"ManagerID = " & rstMgr!ManagerID.Value & ";"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "D:\DAILY AUDIT ACCESS PROJECT\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls"
rstMgr.MoveNext
Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing


Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim DisplayMsg As Boolean

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

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

With objOutlookMsg
' Add the To recipient(s) to the message.


Set objOutlookRecip = .Recipients.Add(rstMgr!ManagerEmail)
objOutlookRecip.Type = olTo


' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Michael Suyama")
'objOutlookRecip.Type = olCC

' Add the BCC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
'objOutlookRecip.Type = olBCC

' Set the Subject, Body, and Importance of the message.
.Subject = Subject
.Body = Message
'.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add("D:\DAILY AUDIT ACCESS PROJECT\" & strMgr & Format(Now(), _
"ddMMMyyy_hhnn") & ".xls")
End If

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing

Exit_SendMessage:
Exit Sub

Err_SendMessage:
MsgBox Error$
Resume Exit_SendMessage

End Sub