Cheers for info.
Tried various attempts but can not get a total records per 'Location' value.
What I would like to get is a number or total count that I can insert into a field on the Front Form.
Cheers
Cheers for info.
Tried various attempts but can not get a total records per 'Location' value.
What I would like to get is a number or total count that I can insert into a field on the Front Form.
Cheers
Can you post the db, or the code you're using now?
Sorry I did mean to paste it but hit the Reply button too quickly!!
Its late again for me !!
Private Sub Command2_Click()
On Local Error GoTo Some_Err
Dim MyDB As DAO.Database, RS As DAO.Recordset
Dim strBody As String, lngCount As Long, lngRSCount As Long
Dim blRet As Boolean
Dim pdfCount As Long
Dim recCount As Long
DoCmd.RunCommand acCmdSaveRecord
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Me!txtProgress = Null
Set RS = MyDB.OpenRecordset("SELECT DISTINCT Location FROM [Equipment List]")
Do Until RS.EOF
pdfCount = pdfCount + 1
Me.txtProgress = RS!Location
'USE THIS LINE BELOW FOR ACCESS 2007
'DoCmd.OutputTo acOutputReport, "Equipment List", acFormatPDF, "C:\datafiles\Test" & RS!Location & ".pdf"
'USE THESE 2 LINES BELOW FOR ACCESS 2003
blRet = ConvertReportToPDF("Equipment List", vbNullString, _
"C:\datafiles\DC" & RS!Location & ".pdf", False, False, 0, "", "", 0, 0)
RS.MoveNext
Loop
'End If
RS.Close
MyDB.Close
Set RS = Nothing
Set MyDB = Nothing
Close
Me!txtProgress = "Created " & CStr(pdfCount) & " Location pdf files."
lblStatus.Caption = "Finished..."
MsgBox "Done creating pdf files. " & vbCrLf & pdfCount, vbInformation, "Done"
lblStatus.Caption = "Idle..."
Exit Sub
Some_Err:
'MousePointer = 0
MsgBox "Error (" & CStr(Err.Number) & ") " & Err.Description, _
vbExclamation, "Error!"
lblStatus.Caption = "Email disconnected"
End Sub
Wouldn't this inside the loop give you the number of records for the current location?
DCount("*", "[equipment list]", "Location = '" & RS!Location & "'")
Hi All,
The code below works a treat and I must thank PBaldy for his massive help.
It selects records from a table and groups them according to a 'location' field.
Using Lebans code it is output to separate pdf files according to the 'Location' field.
My next stage is to get each pdf atttached to an email message with the message either coded in to the VBA or via a field from a linked table called 'Address'.
The 'Address' table is going to contain fields for 'To', 'cc'. It will be linked to the 'Location' field.
I use Thunderbird at home but MS Outlook at work. Testing and reasearch will be done at home with the finished article be used at work.
My trawling of the internet has given me some starting points but I really do not understand fully how to get to my goal.
Any help would be appreciated, Cheers.
Code:Private Sub Command2_Click() On Local Error GoTo Some_Err Dim MyDB As DAO.Database, RS As DAO.Recordset Dim strBody As String, lngCount As Long, lngRSCount As Long Dim blRet As Boolean Dim locCount As Long Dim recCount As Long Dim recTotal As Long DoCmd.RunCommand acCmdSaveRecord Set MyDB = DBEngine.Workspaces(0).Databases(0) Me!txtProgress = Null Set RS = MyDB.OpenRecordset("SELECT DISTINCT Location FROM [Equipment List]") Do Until RS.EOF locCount = locCount + 1 recCount = DCount("*", "[equipment list]", "Location = '" & RS!Location & "'") Me.txtProgress = RS!Location 'USE THIS LINE BELOW FOR ACCESS 2007 'DoCmd.OutputTo acOutputReport, "Equipment List", acFormatPDF, "C:\datafiles\Test" & RS!Location & ".pdf" 'USE THESE 2 LINES BELOW FOR ACCESS 2003 blRet = ConvertReportToPDF("Equipment List", vbNullString, _ "C:\datafiles\Service\" & RS!Location & ".pdf", False, False, 0, "", "", 0, 0) RS.MoveNext lblStatus.Caption = recCount recTotal = recTotal + recCount lblStatus2.Caption = recTotal Loop 'End If RS.Close MyDB.Close Set RS = Nothing Set MyDB = Nothing Close Me!txtProgress = "Created " & CStr(locCount) & " Location based pdf files." lblStatus.Caption = "Finished..." MsgBox "Done creating pdf files. ", vbInformation, "Done" lblStatus.Caption = "Idle..." Exit Sub Some_Err: 'MousePointer = 0 MsgBox "Error (" & CStr(Err.Number) & ") " & Err.Description, _ vbExclamation, "Error!" lblStatus.Caption = "Email disconnected" End Sub
So the the project continues....
I have found this code on Microsofts site. It kinda works but is not exactly what I want. I want to integrate it into the code above, thus picking up the pdf files rather than a hard coded attachment. But let not run before I can walk !!!
I would be chuffed if I could get it to pick up an email "To" address and "Cc" address from a linked table. The "subject" will be the same for all my emails sent this way; so that also can be left on the back burner for now.
I also would like it to be email client system independant. Holy cow, is that possible??
Any help again would be greatly recieved this end.
Cheers
Code:
Code:Sub SendMessages(Optional AttachmentPath) Dim MyDB As Database Dim MyRS As Recordset Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient Dim objOutlookAttach As Outlook.Attachment Dim TheAddress As String Set MyDB = CurrentDb Set MyRS = MyDB.OpenRecordset("tblMailingList") MyRS.MoveFirst ' Create the Outlook session. Set objOutlook = CreateObject("Outlook.Application") Do Until MyRS.EOF ' Create the e-mail message. Set objOutlookMsg = objOutlook.CreateItem(olMailItem) TheAddress = MyRS![EmailAddress] With objOutlookMsg ' Add the To recipients to the e-mail message. Set objOutlookRecip = .Recipients.Add(TheAddress) objOutlookRecip.Type = olTo ' Add the Cc recipients to the e-mail message. If (IsNull(Forms!frmMail!ccAddress)) Then Else Set objOutlookRecip = .Recipients.Add(Forms!frmMail!ccAddress) objOutlookRecip.Type = olCC End If ' Set the Subject, the Body, and the Importance of the e-mail message. .Subject = Forms!frmMail!Subject .Body = Forms!frmMail!MainText .Importance = olImportanceHigh 'High importance 'Add the attachment to the e-mail message. If Not IsMissing(AttachmentPath) Then Set objOutlookAttach = .Attachments.Add(AttachmentPath) End If ' Resolve the name of each Recipient. For Each objOutlookRecip In .Recipients objOutlookRecip.Resolve If Not objOutlookRecip.Resolve Then objOutlookMsg.Display End If Next .Send End With MyRS.MoveNext Loop Set objOutlookMsg = Nothing Set objOutlook = Nothing End Sub
Well, if you remember the code I posted earlier (post 14), where I included:
'I have code here to send an email with the above attached (again just the loop)
The actual code looks like:
Which as you can see uses the same path used to create the PDF for the attachment. In my case, the users wanted the emails left open for review prior to sending, which is why I have .Send commented out.Code:Do While Not rs.EOF Forms!frmStatementFilter.txtEmailCust = rs!CustomerAccount blRet = ConvertReportToPDF(strReport, vbNullString, _ "c:\" & rs!CustomerAccount & "Statement.pdf", False, False, 0, "", "", 0, 0) DoEvents Set MyOutlook = CreateObject("Outlook.Application") Set MyMail = MyOutlook.CreateItem(0) MyMail.To = rs!MaxOfEmail MyMail.Subject = rs!CompanyName & " statement for " & rs!MaxOfName Set myattachments = MyMail.Attachments myattachments.Add "c:\" & rs!CustomerAccount & "Statement.pdf" MyMail.Body = "Your statement is attached" 'MyMail.Send MyMail.Display rs.MoveNext Loop
Now, as to email client independence, that's another kettle of fish. The methods I would use for that don't allow for the non-Access attachment. Not saying there aren't methods, but being in an Outlook environment, I haven't needed them. I'll poke around.
Cheers Paul, appreciate it very much
Thanks
I use CDO and it works a treat! http://www.ffdba.com/downloads/Send_E-Mail_With_CDO.htm
Thanks for reply.
Can you describe what the CDO method is and what the differencies are to other methods?
Cheers,
The simplest description I can give is that CDO talks directly with your SMTP server and bypasses your email client. Try it out.
Cheers for reply. Its just that I noticed that the following code was included in your link and had not got a clue what it was supposed to be doing?
Code:With iCfg.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.cogeco.ca" .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" .Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = "your name <your email address>" .Update End With
I'll have to admit, I don't know details to that depth., sorry.