Code: Private Sub btnEmail_Click() ' If you don't want the report dialog box being displayed ' asking what name you want to give the pdf report, you will ' need pdfEdit995. With pdfEdit995t you tell pdf995 what directory ' and what file name to initially give the pdf report. ' ' Quote from PDF; "pdfEdit995 has autoname features. I recommend setting ' the PDF to be named based on the document being printed. Create a ' temporary report with the name of the PDF you want and tell it to ' print to PDF995. The Save As dialog won't appear." Dim strDir As String Dim strFile As String Dim fOK As Boolean ' Directory to place the PDF files that are to ' be printed strDir = "D:Documents and SettingsHeatherMy DocumentsOutsourced ProjectsTyco" ' Name of file to create strFile = "DFM Summary Statistics Queried " & Format(Date, "Long Date") & ".pdf" ' Create the report DoCmd.OpenReport "rptStats", acViewNormal ' Copy the created file (name is Output.pdf) to the ' directory and file name specified above fOK = CopyFile_TSB(strDir & "Output.pdf", strDir & strFile) 'If the file didn't copy properly, tell the user If Not fOK Then Beep MsgBox "File Copy Failure" End If SendMessage (strDir & strFile) End Sub Function CopyFile_TSB(strSource As String, strDestination As String) As Boolean ' Comments : copies a file ' Parameters: strSource - source file ' strDestination - destination file ' Returns : True if successful, False otherwise ' Const BufferSize = 9000 Dim strBuffer As String * BufferSize Dim strTempBuffer As String Dim intSourceFile As Integer Dim intDestinationFile As Integer Dim lngCounter As Long On Error GoTo PROC_ERR intSourceFile = FreeFile Open strSource For Binary As #intSourceFile intDestinationFile = FreeFile Open strDestination For Binary As #intDestinationFile For lngCounter = 1 To LOF(intSourceFile) BufferSize Get #intSourceFile, , strBuffer Put #intDestinationFile, , strBuffer Next lngCounter lngCounter = LOF(intSourceFile) Mod BufferSize If lngCounter > 0 Then Get #intSourceFile, , strBuffer strTempBuffer = Left$(strBuffer, lngCounter) Put #intDestinationFile, , strTempBuffer End If Close #intSourceFile Close #intDestinationFile CopyFile_TSB = True PROC_EXIT: Exit Function PROC_ERR: CopyFile_TSB = False Resume PROC_EXIT End Function Private Sub btnCancel_Click() On Error GoTo Err_btnCancel_Click Dim stDocName As String stDocName = "CustStatsSelect.Cancel" DoCmd.RunMacro stDocName Exit_btnCancel_Click: Exit Sub Err_btnCancel_Click: MsgBox Err.Description Resume Exit_btnCancel_Click End Sub Sub SendMessage(Optional AttachmentPath) Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient Dim objOutlookAttach As Outlook.Attachment ' 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("firstname.lastname@example.org") objOutlookRecip.Type = olTo ' Add the CC recipient(s) to the message. Set objOutlookRecip = .Recipients.Add(" ") objOutlookRecip.Type = olCC ' Set the Subject, Body, and Importance of the message. .Subject = "DFM Statistics Summary" .Body = "" .Importance = olImportanceHigh 'High importance ' Add attachments to the message. Dim strFile As String strFile = "D:Documents and SettingsHeatherMy DocumentsOutsourced ProjectsTycoDFM Summary Statistics Queried " & Format(Date, "Long Date") & ".pdf" If Not IsMissing(AttachmentPath) Then Set objOutlookAttach = .Attachments.Add(strFile) End If ' Resolve each Recipient's name. For Each objOutlookRecip In .Recipients objOutlookRecip.Resolve If Not objOutlookRecip.Resolve Then objOutlookMsg.Display End If Next .Display End With Set objOutlookMsg = Nothing Set objOutlook = Nothing End SubI appreciate any help you can give me!
Code: DoCmd.SendObject acSendReport, "rptInvoice", acFormatPDF, email, , , subject, msgText, FalseThe problem is, the report, wich is the invoice, needs to be filtered separately for each e-mail / pass of the loop. The only way I can think of to do this in code is to open the report, apply a filter, and save the report. Not sure if this will work or not but if it does it will cause the report to flash on the screen each pass of the loop. Can anyone direct me as to how to e-mail invoice reports in a batch, each one filtered for it's intended recipient?
Code: Dim obEmail As Object, obMsg As Object, obAttachment As Object, stDelim As String, exAttach As String stDelim = ";" Set obEmail = CreateObject("Outlook.Application") Set obMsg = obEmail.CreateItem(olMailItem) With obMsg .subject = "Ordering Report" .To = "users" .Body = "Please see attached." .Send End With Set obEmail = Nothing Set obMsg = Nothing End FunctionI thought about using the 'SentOnBehalfOfName' property but from what I've seen this does not change the e-mail address. This is key since the recipients will probably reply back and these replies need to be routed to the correct profile.
Code: Attribute VB_Name = "mdlSendEmail" Option Compare Database 'sends rejection report e-mails and saves copy to shared area Public Function Sendrpt3() Dim variableCC As String Dim Scheme As String Dim Street As String Dim Packref As String Dim datestamp As String Dim Filename As String On Error Resume Next Scheme = Forms!frmpackdata.txtAsset Street = Forms!frmpackdata.TxtStreet Packref = Forms!frmpackdata.txtPack datestamp = Format(Now, "yyyyMMdd-hhmmss") Filename = "network pathreports" & datestamp & "-" & Packref & ".snp" DoCmd.OutputTo acReport, "rptESRIReport", "SnapshotFormat(*.snp)", Filename, False, "", 0 If Forms!frmpackdata!txtCoord = "" Then variableCC = "" Else variableCC = Forms!frmpackdata!txtCoord & "@companyname.com" End If ' handle scenario where the above lines still only returns the e-mail domain name @companyname.com If variableCC = "@companyname.com" Then variableCC = "" End If DoCmd.SendObject acReport, "rptESRIReport", "SnapshotFormat(*.snp)", Forms!frmpackdata!txtOneNet & "@companyname.com", Forms!frmpackdata!txtTeamLeader & "@companyname.com" & "; " & variableCC, "email@example.com", "QA Audit Rejection - Pack Ref " & Packref & ": " & Scheme & " - " & Street, "", True, "" End FunctionI'm at a bit of a loss as to how this seems to be executing fine on some machines and not others, are there any known issues with the SendObject command in Office 2003 which would explain this behaviour and is there a better, more reliable method of achieving it?
Code: Private Sub Email_Decorations_Click() Dim strRep As String Dim strDPath As String Dim strFName As String ' What report to send strRep = "Decorations Pending" ' Initial Path strDPath = "Path name here" ' Filename strFName = "Decorations.pdf" ' Output report as pdf DoCmd.OutputTo acOutputReport, strRep, "PDFFormat(*.pdf)", strDPath & strFName, False, "", 0 ' Send the report to whoever Send_Dec (strDPath & strFName) End Sub Private Sub Send_Dec(strDoc As String) Dim sTo As String Dim sCC As String Dim sBCC As String Dim sSub As String Dim sBody As String Dim strCC As String Dim OutApp As Object Dim OutMail As Object Dim varPress As Variant ' Get the email address from the current form control sTo = "" ' Set the subject sSub = "Evals & Decs" ' Build the body of the email sBody = "Team," & vbCrLf & vbCrLf sBody = sBody & "Here is the current decorations list for action." ' Create the email Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) sCC = "" sBCC = "" With OutMail .To = sTo .CC = sCC .BCC = sBCC .Subject = sSub .Body = sBody .attachments.Add (strDoc) .display End With Set OutMail = Nothing Set OutApp = Nothing End Sub