vba code needs amending

[classmaz]

Hello I have inherited a database that exports 116 reports/files from a vba code. However I would like to amend the code to also email the 116 reports to the relevant 52 people. The email address are located in the Sales Area table which has 3 fields and 52 rows:

Sales Area
Area code
Email

The code below cycles through this table splitting the main table by area code.


sub Experiment()

'On Error GoTo ErrorCheck

Dim db As Database
Dim qdf As QueryDef
Dim Pcount As Integer
Dim Pprogress As Integer
Dim NidsCount As Integer
Dim BreaksCount As Integer


Set db = CurrentDb

NidsCount = 0
For Each qdf In db.QueryDefs
If qdf.Name Like "*Daily Nids Report" Then
NidsCount = NidsCount + 1
End If
Next

BreaksCount = 0
For Each qdf In db.QueryDefs
If qdf.Name Like "*Daily Breakdown" Then
BreaksCount = BreaksCount + 1
End If
Next

Pcount = BreaksCount + NidsCount

DoCmd.OpenForm "FRMnidsprogress"

Pprogress = Forms![frmnidsprogress].Box4.Width / Pcount

Forms![frmnidsprogress].Text6 = "Running Nids And Breakdowns"
Forms![frmnidsprogress].Box5.Width = 0
Forms![frmnidsprogress].Box5.BackColor = 15898517

For Each qdf In db.QueryDefs
If qdf.Name Like "the Daily breakdown" Then
Else
If qdf.Name Like "*Daily breakdown" Then
DoCmd.TransferSpreadsheet acExport, 8, qdf.Name, "G:\nids test\emails\progressnids\" & qdf.Name & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
Forms![frmnidsprogress].Box5.Width = Forms![frmnidsprogress].Box5.Width + Pprogress
Forms![frmnidsprogress].Box5.BackColor = 15898517
End If
End If
Next

For Each qdf In db.QueryDefs
If qdf.Name Like "the Daily Nids Report" Then
Else
If qdf.Name Like "*Daily Nids Report" Then
DoCmd.TransferSpreadsheet acExport, 8, qdf.Name, "G:\nids test\emails\progressnids\FYI" & qdf.Name & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
Forms![frmnidsprogress].Box5.Width = Forms![frmnidsprogress].Box5.Width + Pprogress
End If
End If
Next

DoCmd.TransferSpreadsheet acExport, 8, "Sales Scotland Unique Apps", "G:\nids test\emails\progressnids\FYI" & "Sales Scotland Daily Nids Report" & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
'Sales Scotland Unique Apps
'Postcode reports
'Dim db As Database
Dim Area_Code_Table As Recordset
'Set db = CurrentDb

Dim LAF_Code As Integer
Dim Sales_Area1 As String
Dim Base_SQL As String
Dim QueryDefName As String
'Dim qdf As QueryDef
Dim RptName As String


Base_SQL = "Select [Daily Postcode Report].[CountOfAppnameref],[Daily Postcode Report].[Postcode],[Daily Postcode Report].[Addr First Line],[Daily Postcode Report].[To User],[Daily Postcode Report].[Application Ref],[Daily Postcode Report].[Application Name],[Daily Postcode Report].[Search Creation Date],[Daily Postcode Report].[Post Applied For],[Daily Postcode Report].[Notification id],[Daily Postcode Report].[LAF Code] from [Daily Postcode Report]where [Daily Postcode Report].[LAF code]="

Set Area_Code_Table = db.OpenRecordset("Postcode Report List")

Do While Not Area_Code_Table.EOF

LAF_Code = Area_Code_Table("Area Code")
Sales_Area1 = Area_Code_Table("sales area")

'QueryDefName = Sales_area1 & "" & " Hardship Case Escalations"
QueryDefName = "Daily Postcode Report Export"
CurrentDb.CreateQueryDef QueryDefName, Base_SQL & "'" & LAF_Code & "'"

'If DCount("*", Sales_area1 & "" & " Hardship Case Escalations") = 0 Then
'CurrentDb.QueryDefs.Delete QueryDefName
'Area_Code_Table.MoveNext
'Else

If DCount("*", "Daily Postcode Report Export") = 0 Then
CurrentDb.QueryDefs.Delete QueryDefName
Area_Code_Table.MoveNext
Else

RptName = Sales_Area1 & "" & " Daily Postcode Report"

Dim XLapp As New Excel.Application
Dim worksheet As Excel.worksheet
Dim ObjXL As Excel.Workbook
Set ObjXL = XLapp.Workbooks.Open("G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE.xls")
ObjXL.Application.Visible = True
ObjXL.Windows(1).Visible = True
ObjXL.Worksheets(2).Activate
Set worksheet = XLapp.Worksheets(2)
With worksheet
.range("A:J").ClearContents
End With
ObjXL.Save
ObjXL.Close
XLapp.Quit

DoCmd.TransferSpreadsheet acExport, 8, "Daily Postcode Report Export", "G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE"

Set ObjXL = XLapp.Workbooks.Open("G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE.xls")
ObjXL.Application.Visible = True
ObjXL.Windows(1).Visible = True
ObjXL.Worksheets(1).Activate
killsometime
ObjXL.SaveAs "G:\nids test\emails\progressnids\" & RptName & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
ObjXL.Close
XLapp.Quit

Dim Skill As String
Skill = "taskkill /F /IM msexcel.exe"
'Shell Skill, vbHide

CurrentDb.QueryDefs.Delete QueryDefName
Area_Code_Table.MoveNext
End If
Loop





Exit Sub

Forms![frmnidsprogress].Box5.BackColor = 7095511
Forms![frmnidsprogress].Text6 = "Nids And Breakdowns Complete"


End Sub


any help appreciated

[OBP]

So is the "Area Code" in the Sales Area Table the same as the LAF Code?

[classmaz]

So is the "Area Code" in the Sales Area Table the same as the LAF Code?
Yes they are the exact same thing

thanks

[OBP]

So, the only place that I see the LAF Code used is in the Base_SQL statement where it is set using this code
LAF_Code = Area_Code_Table("Area Code")
So I would assume that it would be used to iterate through the Sales Area table to find matching codes and then send an email to the email addresses attached to the Area Code?

[classmaz]

Yes that should do it but unfortunately I wouldn’t know how to code it

[OBP]

That is the part that I do, but I obviously need to get it in the right place and using the right data.
What Emailing software do you use?

[classmaz]

The software is Microsoft outlook do you need the version?

[OBP]

I shouldn't do, but you will have to set a VBA Editor Library Reference to it.
I suggest that you take a copy of the database where you can test any code that I supply until you are happy it is doing what you want.

[classmaz]

I shouldn't do, but you will have to set a VBA Editor Library Reference to it.
I suggest that you take a copy of the database where you can test any code that I supply until you are happy it is doing what you want.
Yes that’s what I was planning on doing :)

[OBP]

What format is the Area Code?
Alpha, Numeric or AlphaNumeric?

ps OK, I see it is Integer.

[classmaz]

What format is the Area Code?
Alpha, Numeric or AlphaNumeric?

ps OK, I see it is Integer.

I’ve juat looked at the table properties and they have them as text. When I look into it some of the area codes start with a 0.

[OBP]

That is interesting as this
Dim LAF_Code As Integer
sets the LAF_Code to Numeric
What about the Area Code Table?

[OBP]

OK, here is a standalone database that mimics your Table.
On the form select on of the Area Codes and click the test code button and it should send me an email.
To change it to an email address you can access go in to the Area Sales table and put it in.

[classmaz]

Hi just checked it’s text too but I suppose if they turn to interger for both datasets it doesn’t really matter. for example 01 would become 1 and that would still be unique. Just the system dumps the data every day as 01 in a text format

[classmaz]

That dB loads the email but doesn’t automatically send. Also I was hoping that this Code could be incorporated into the original so it would just cycle through the area code table generating the files and emails.

[OBP]

We will get there, this is just for testing.

[classmaz]

We will get there, this is just for testing.
Thanks mate

[OBP]

Sorry for the delay in responding, my Wife has been using the computer.
First of all this line of code

DoCmd.SendObject , , , emailto, , , Subject, Body, True

Is the part that sends the email and the true on the end means it won't send it until it is sent by the user.
Change the true to False and it should then send it automatically.

Next I would like you to Import the Form in my database in to your database and try the button there to see if it can
1. read your Sales Area table and
2. recognise the Area Code.
We may have to change it to Text or change your text to a numeric value for it work with your tables.

[classmaz]

Sorry for the delay in responding, my Wife has been using the computer.
First of all this line of code

DoCmd.SendObject , , , emailto, , , Subject, Body, True

Is the part that sends the email and the true on the end means it won't send it until it is sent by the user.
Change the true to False and it should then send it automatically.

Next I would like you to Import the Form in my database in to your database and try the button there to see if it can
1. read your Sales Area table and
2. recognise the Area Code.
We may have to change it to Text or change your text to a numeric value for it work with your tables.

I will try it later or tomorrow as I am out at the moment. I am going to buy a ms access vba for idiots book as this is just outside my comfort zone. Or do you have another book I should loook at?

[OBP]

It depends on how much you want to spend.
It should give you the basics, although I have never looked at it.
I would suggest having a look in your local library to see if they have anything.

[classmaz]

Tried it today and it came up with an error. I will report back what it was in a minute

[OBP]

I thought it might, which is why I did it this way, rather than inserting it in to your code.

[classmaz]

The error message is
Microsoft access can’t find the field “|” referee to in your expression

[classmaz]

Fixed the error it was my mistake. The form is now looking at my table and pulling the relevant email

[OBP]

OK, did the Form that you imported open and display the records in your Sales Area table?
I could add all the fields to the form so that you can check it displays the data.
Have you checked how the Field names in your table compare to the field names in my table?
Did it highlight a line of code when it displayed the error message?

[OBP]

OK, you posted while I was checking the database and writing my response.
Does it populate the email message?

[classmaz]

The email is generated it pulls the email address from the table and just puts the generic message in at the moment. This all relies on me selecting a area code from your form.

[OBP]

Yes, so the code works with your Table, have you read the notes on my code, it tells you what is not needed in your code as they are duplicates of what you have?
Will there be more than one recipient per email?

[classmaz]

Yes I’ve read through your notes I’m just uncertain at which point I would put your code would it be after the saving the excel file?

[OBP]

What about the number of recipients?

[classmaz]

Yes there will be more than 1 recipient but i Was thinking I could just put in the email field classmaz@whatever.com;classmaz2@whatever.com etc

[OBP]

I would try it after this line


CurrentDb.CreateQueryDef QueryDefName, Base_SQL & "'" & LAF_Code & "'"

[OBP]

If the recipients are in the table the code can put them in.

[OBP]

I am not sure if you will need to split the code up, placing the Dim statements at the start of your code.

[OBP]

I have to go now, I will talk to you again tomorrow.

[OBP]

I have looked at the code and this part
Dim db As Database 'not needed in your database
Dim LAF_Code As Integer 'not needed in your database
Dim rsArea As Object, emailto As String, Subject As String, Body As String, reccount As Integer, count As Integer
On Error GoTo errorcatch
Set db = CurrentDb 'not needed in your database
Set rsArea = db.OpenRecordset("Sales Area")
rsArea.MoveLast
rsArea.MoveFirst
reccount = rsArea.RecordCount
LAF_Code = Me.[Area Selected] ' not needed in your database
Subject = "Your Area Report for area " & LAF_Code & " is ready"
Body = "Please access your Area Report as soon as possible"

Should be at the start of your code, note you can change the Subject and Body there.
This part of of the code
For count = 1 To reccount
If rsArea.[Area code] = LAF_Code Then
emailto = rsArea.Email 'emailto & rsArea.email
End If
rsArea.MoveNext
Next count
DoCmd.SendObject , , , emailto, , , Subject, Body, True


should be after
CurrentDb.CreateQueryDef QueryDefName, Base_SQL & "'" & LAF_Code & "'"

To have more Recipients added from the table you need to add a line of code before the loop
emailto = "" ' reset the email to nothing

You then need to change this line
emailto = rsArea.Email 'emailto & rsArea.email
to
emailto = 'emailto & "; " & rsArea.Email 'add email to the variable emailto

and finally after
Next count
add
emailto = right(emailto, len(emailto)-1) ' strip the leading ";"

You should also add this after the Exit Sub

errorcatch:
MsgBox Err.Description

to match the earlier goto, as your error trap is disabled.