Outputto overwrite existing file in a loop
I'm trying to send an email notice to multiple people, each with an attachment showing their own records. It works fine except that it will only send one at a time. When it tries to send the second one, it stops when trying to export the file; however, after the code runs, then that file is deleted and I can run the code again. Why is it stopping instead of creating the second file?
Private Sub Command1_Click()
On Error GoTo Err_Command1_Click
Dim iCfg As Object
Dim iMsg As Object
Set iCfg = CreateObject("CDO.Configur
Set iMsg = CreateObject("CDO.Message"
With iCfg.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Forms!pFrmMailServer!MailP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Forms!pFrmMailServer!MailS
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Forms!pFrmMailServer!txtSS
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Forms!pFrmMailServer!MailA
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Forms!pFrmMailServer!MailU
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Forms!pFrmMailServer!MailP
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = Forms!pFrmMailServer!MailF
.Update
End With
DoCmd.OpenForm "frmMailGroup", acNormal, , , acFormEdit, acWindowNormal
DoCmd.GoToRecord acForm, "frmMailGroup", acFirst
DoCmd.RunCommand acCmdSelectRecord
DoCmd.SetWarnings False
Do
Do While Forms!FrmMailGroup!StaffID
DoCmd.OutputTo acOutputQuery, "qryEmailDueExport", acFormatRTF, CurrentProject.Path & "\TrainingDue.rtf", False
With iMsg
.Configuration = iCfg
.Subject = "Notice of Training Due"
.To = Forms!FrmMailGroup!Email
.TextBody = Forms!FrmMailGroup!FirstNa
"" & Chr$(13) & _
Forms!pFrmMailServer!DueTe
"" & Chr$(13) & _
" Training: " & Forms!FrmMailGroup!CertNam
" Number: " & Forms!FrmMailGroup!CertNum
" Completed: " & Forms!FrmMailGroup!Complet
" Expires: " & Forms!FrmMailGroup!Exp
.AddAttachment ("file://" & CurrentProject.Path & "\TrainingDue.rtf")
.Send
End With
DoCmd.OpenQuery "qryEmailDueSave", acViewNormal, acEdit
Dim KillFile As String
KillFile = CurrentProject.Path & "\TrainingDue.rtf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
DoCmd.GoToRecord acForm, "frmMailGroup", acNext
DoCmd.GoToControl "StaffID"
DoCmd.RunCommand acCmdSelectRecord
Exit Do
Loop
Loop Until IsNull(Forms!FrmMailGroup!
Set iMsg = Nothing
Set iCfg = Nothing
DoCmd.SetWarnings True
DoCmd.Close acForm, "frmMailGroup", acSaveNo
MsgBox "Notices sent.", vbOKOnly, "TRAIN TRACK®"
Exit_Command1_Click:
Exit Sub
Err_Command1_Click:
DoCmd.Close acForm, "frmMailGroup", acSaveNo
MsgBox "Notices were sent. There may be additional notices to send.", vbOKOnly, "TRAIN TRACK®"
Resume Exit_Command1_Click
End Sub
Private Sub Command1_Click()
On Error GoTo Err_Command1_Click
Dim iCfg As Object
Dim iMsg As Object
Set iCfg = CreateObject("CDO.Configur
Set iMsg = CreateObject("CDO.Message"
With iCfg.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Forms!pFrmMailServer!MailP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Forms!pFrmMailServer!MailS
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Forms!pFrmMailServer!txtSS
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Forms!pFrmMailServer!MailA
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Forms!pFrmMailServer!MailU
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Forms!pFrmMailServer!MailP
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = Forms!pFrmMailServer!MailF
.Update
End With
DoCmd.OpenForm "frmMailGroup", acNormal, , , acFormEdit, acWindowNormal
DoCmd.GoToRecord acForm, "frmMailGroup", acFirst
DoCmd.RunCommand acCmdSelectRecord
DoCmd.SetWarnings False
Do
Do While Forms!FrmMailGroup!StaffID
DoCmd.OutputTo acOutputQuery, "qryEmailDueExport", acFormatRTF, CurrentProject.Path & "\TrainingDue.rtf", False
With iMsg
.Configuration = iCfg
.Subject = "Notice of Training Due"
.To = Forms!FrmMailGroup!Email
.TextBody = Forms!FrmMailGroup!FirstNa
"" & Chr$(13) & _
Forms!pFrmMailServer!DueTe
"" & Chr$(13) & _
" Training: " & Forms!FrmMailGroup!CertNam
" Number: " & Forms!FrmMailGroup!CertNum
" Completed: " & Forms!FrmMailGroup!Complet
" Expires: " & Forms!FrmMailGroup!Exp
.AddAttachment ("file://" & CurrentProject.Path & "\TrainingDue.rtf")
.Send
End With
DoCmd.OpenQuery "qryEmailDueSave", acViewNormal, acEdit
Dim KillFile As String
KillFile = CurrentProject.Path & "\TrainingDue.rtf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
DoCmd.GoToRecord acForm, "frmMailGroup", acNext
DoCmd.GoToControl "StaffID"
DoCmd.RunCommand acCmdSelectRecord
Exit Do
Loop
Loop Until IsNull(Forms!FrmMailGroup!
Set iMsg = Nothing
Set iCfg = Nothing
DoCmd.SetWarnings True
DoCmd.Close acForm, "frmMailGroup", acSaveNo
MsgBox "Notices sent.", vbOKOnly, "TRAIN TRACK®"
Exit_Command1_Click:
Exit Sub
Err_Command1_Click:
DoCmd.Close acForm, "frmMailGroup", acSaveNo
MsgBox "Notices were sent. There may be additional notices to send.", vbOKOnly, "TRAIN TRACK®"
Resume Exit_Command1_Click
End Sub
99/100 training.rtf is still in use when you try to kill it
Dim KillFile As String
KillFile = CurrentProject.Path & "\TrainingDue.rtf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
That won't end well.
Has this code worked well before?
I would do something to make each CurrentProject.Path & "\TrainingDue.rtf" unique, either by adding some value from the form or an incremented variable, and then deleting the resulting files at the end of the routine.
It is possible in the past, the machine running this was slow enough the file usage completed in time. Now, as faster machine executes the loop quickly enough that it does not. There are routines to check to see if a file is in use. You'd throw in a loop to check that the file was free to be deleted and THEN kill it.
Dim KillFile As String
KillFile = CurrentProject.Path & "\TrainingDue.rtf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
That won't end well.
Has this code worked well before?
I would do something to make each CurrentProject.Path & "\TrainingDue.rtf" unique, either by adding some value from the form or an incremented variable, and then deleting the resulting files at the end of the routine.
It is possible in the past, the machine running this was slow enough the file usage completed in time. Now, as faster machine executes the loop quickly enough that it does not. There are routines to check to see if a file is in use. You'd throw in a loop to check that the file was free to be deleted and THEN kill it.
ASKER
But if it won't delete the files...then I end up with a bunch of junk. That's the issue, that the file is in use so it won't delete it. How do I get it to not be in use so I can delete it?
And if my code is old and should be updated, some suggestions would be appreciated.
Thanks!
And if my code is old and should be updated, some suggestions would be appreciated.
Thanks!
ASKER
Oh yeah, I already tried it with warnings on, and message boxes after every step. I don't get any error messages (except my own). It just stops right before it outputs the second time.
What version of Access are you running?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Access 2010. That worked the same as before, it stops before it outputs the second file.
You could also distinctly name each file. For example, instead of naming all of the outputs "trainingdue.rtf", you could append the username to it, or something of that nature:
DoCmd.OutputTo acOutputQuery, "qryEmailDueExport", acFormatRTF, CurrentProject.Path & "\TrainingDue" & Me.SomeFieldOnYourForm & ".rtf", False
Then, when you're done with the email stuff, just loop through the directory and delete all the files ending in .rtf:
Dim file As String
file = Dir(CurrentProject.Path, "*.rtf")
Do Until Len(file) = 0
Kill CurrentProject.Path & "\" & file & ".rtf"
file = Dir
Loop
You may still need to use Nick's looping technique, depending on what you're doing with those RTF files.
Also curious why you're not outputting to PDF, which generally is a lot faster than outputting to RTF.
DoCmd.OutputTo acOutputQuery, "qryEmailDueExport", acFormatRTF, CurrentProject.Path & "\TrainingDue" & Me.SomeFieldOnYourForm & ".rtf", False
Then, when you're done with the email stuff, just loop through the directory and delete all the files ending in .rtf:
Dim file As String
file = Dir(CurrentProject.Path, "*.rtf")
Do Until Len(file) = 0
Kill CurrentProject.Path & "\" & file & ".rtf"
file = Dir
Loop
You may still need to use Nick's looping technique, depending on what you're doing with those RTF files.
Also curious why you're not outputting to PDF, which generally is a lot faster than outputting to RTF.
@Scott
I think this is legacy code.
A2003- could not outputto PDF, so you had rtf, snp, and worse choices.
What version was the first for SendObject?
I think this code pre-dates that.
CDO stopped shipping with O2007 so someone had to flange the dll in to keep this working.
How would YOU do this greenfield today?
Nick67
I think this is legacy code.
A2003- could not outputto PDF, so you had rtf, snp, and worse choices.
What version was the first for SendObject?
I think this code pre-dates that.
CDO stopped shipping with O2007 so someone had to flange the dll in to keep this working.
How would YOU do this greenfield today?
Nick67
SendObject has been around since at least A97, but it may be even older than that.
Many people used the Lebans PDF code to work around the PDF limitation:
http://www.lebans.com/reporttopdf.htm
For me, using vbMAPI from www.everythingaccess.com with Outlook gives me everything I need to work easily with Outlook. For ~$90 USD it's we'll worth the investment (and it doesn't require any dependent files - everything is included in your Access database).
Many people used the Lebans PDF code to work around the PDF limitation:
http://www.lebans.com/reporttopdf.htm
For me, using vbMAPI from www.everythingaccess.com with Outlook gives me everything I need to work easily with Outlook. For ~$90 USD it's we'll worth the investment (and it doesn't require any dependent files - everything is included in your Access database).
ASKER
It didn't really solve the issue but I will try saving multiple files, and I will look for some different code to send the auto emails. Thanks!
This is from the Access 2003 help file.
In A2007+ you have an option for PDF as the OutputFormat
But if it didn't solve the problem, why close the question?
In A2007+ you have an option for PDF as the OutputFormat
But if it didn't solve the problem, why close the question?
SendObject Method
The SendObject method carries out the SendObject action in Visual Basic.
expression.SendObject(ObjectType, ObjectName, OutputFormat, To, Cc, Bcc, Subject, MessageText, EditMessage, TemplateFile)
expression Required. An expression that returns one of the objects in the Applies To list.
ObjectType Optional AcSendObjectType.
AcSendObjectType can be one of these AcSendObjectType constants.
acSendDataAccessPage
acSendForm
acSendModule
acSendNoObject default
acSendQuery
acSendReport
acSendTable
ObjectName Optional Variant. A string expression that's the valid name of an object of the type selected by the objecttype argument. If you want to include the active object in the mail message, specify the object's type with the objecttype argument and leave this argument blank. If you leave both the objecttype and objectname arguments blank (the default constant, acSendNoObject, is assumed for the objecttype argument), Microsoft Access sends a message to the electronic mail application without an included database object. If you run Visual Basic code containing the SendObject method in a library database, Microsoft Access looks for the object with this name first in the library database, then in the current database.
OutputFormat Optional Variant.
To Optional Variant. A string expression that lists the recipients whose names you want to put on the To line in the mail message. Separate the recipient names you specify in this argument and in the cc and bcc arguments with a semicolon (;) or with the list separator set on the Number tab of the Regional Settings Properties dialog box in Windows Control Panel. If the recipient names aren't recognized by the mail application, the message isn't sent and an error occurs. If you leave this argument blank, Microsoft Access prompts you for the recipients.
Cc Optional Variant. A string expression that lists the recipients whose names you want to put on the Cc line in the mail message. If you leave this argument blank, the Cc line in the mail message is blank.
Bcc Optional Variant. A string expression that lists the recipients whose names you want to put on the Bcc line in the mail message. If you leave this argument blank, the Bcc line in the mail message is blank.
Subject Optional Variant. A string expression containing the text you want to put on the Subject line in the mail message. If you leave this argument blank, the Subject line in the mail message is blank.
MessageText Optional Variant. A string expression containing the text you want to include in the body of the mail message, after the object. If you leave this argument blank, the object is all that's included in the body of the mail message.
EditMessage Optional Variant. Use True (–1) to open the electronic mail application immediately with the message loaded, so the message can be edited. Use False (0) to send the message without editing it. If you leave this argument blank, the default (True) is assumed.
TemplateFile Optional Variant. A string expression that's the full name, including the path, of the file you want to use as a template for an HTML file.
Remarks
For more information on how the action and its arguments work, see the action topic.
Modules can be sent only in MS-DOS Text format, so if you specify acSendModule for the objecttype argument, you must specify acFormatTXT for the outputformat argument.
To send a snapshot, set the ObjectType argument to acSendReport and the OutputFormat argument to acFormatSNP.
You can leave an optional argument blank in the middle of the syntax, but you must include the argument's comma. If you leave a trailing argument blank, don't use a comma following the last argument you specify.
Example
The following example includes the Employees table in a mail message in Microsoft Excel format and specifies To, Cc, and Subject lines in the mail message. The mail message is sent immediately, without editing.
DoCmd.SendObject acSendTable, "Employees", acFormatXLS, _
"Nancy Davolio; Andrew Fuller", "Joan Weber", , _
"Current Spreadsheet of Employees", , False
That's old code :)
CDO's been deprecated since A2007, and frowned upon since A2002.
You are on the clock for updating this, but no matter.
DoCmd.SetWarnings False
DoCmd.SetWarnings True
It is very hard to see for yourself what the problem may be if you have turned the warnings off :)
Comment those out for the meantime, and post what error messages you get.