DoCmd.SendObject

[aziz rasul]

I have the following code: -

DoCmd.SendObject acSendTable, "tblExport", acFormatXLS, "dan.edwards@nhs.uk", "", "", "Subject", "Message", False, ""

When I try this on my machine it doesn't work but it does on a colleagues machine. Can anyone understand why this should be?

 

[Travis]

Are you getting a message (Such as an Error) or does it just step through the code like nothing happened?

Are you using Error Trapping? If you are and you are using "On Error Resume Next" then remark this out and try again.

Other thing to try,

Make sure that OutLook is open on your PC and then run the code.

Temporaraly turn off any Virus Scans and then run the code.

 

[aziz rasul]

It just runs through the code, no errors occur and sometimes it works. I'll get 2 out of 500 emails and other times I don't get any. Late yesterday I managed to get more than 5. Seems erratic in the way it works. Outlook is open.

 

[Travis]

Please post your code so that I can look at it and make suggestions.

 

[aziz rasul]

DoCmd.SendObject acSendTable, strTrustName, "MicrosoftExcel(*.xls)", "aziz.rasul@pasa.nhs.uk", "", "", strTrustName & " - Costing Savings Report", strBodyText, False, ""

 

[Travis]

I had ment the whole procedure not just the single line.


However, I have researched some of my notes and one that I have concerning the DoCmd.SendObjects is that It does not perform well in LOOPS (For Loops, While Loops etc.)

My note was to create a seperate function (Passing it the needed items and returning a booean [pass/fail])

These became benificial to me as now I had an email function and did not have to keep repeating all the standard stuff over and over.

 

[aziz rasul]

Do While Not rstTrust.EOF
strTrustName = rstTrust.Fields(1)
Forms!frmMainMenu.[txtStatus] = "Collecting data for " & strTrustName & "."
DoCmd.RepaintObject acForm, "frmMainMenu"
strSQL = "DELETE * FROM tblExport;"
DoCmd.RunSQL strSQL
'Query1
strSQL = "SELECT tblReportData4.[Existing NPC], tblReportData4.[Existing Supplier], "
strSQL = strSQL & "tblReportData4.[New NPC], tblReportData4.[New Supplier], "
strSQL = strSQL & "tblReportData4.Comments, tblReportData4.[Annual Volume], "
strSQL = strSQL & "tblReportData4.[January 05 Price B1], tblReportData4.[B1 New Price], "
strSQL = strSQL & "tblReportData4.[B1 Saving], tblReportData4.[January 05 Price B2], "
strSQL = strSQL & "tblReportData4.[B2 New Price], tblReportData4.[B2 Saving], "
strSQL = strSQL & "tblReportData4.[January 05 Price B3], tblReportData4.[B3 New Price], "
strSQL = strSQL & "tblReportData4.[B3 Saving], tblReportData4.BRAND, "
strSQL = strSQL & "tblReportData4.CAT_BASE_DESC, tblReportData4.CAT_SEC_DESC, "
strSQL = strSQL & "tblReportData4.SUMOFSUP_QTY, tblReportData4.UOI, tblReportData4.UNITS, "
strSQL = strSQL & "tblReportData4.PRICE_BAND, tblReportData4.VAT_FLAG, tblTrusts.DIST_NAME, "
strSQL = strSQL & "tblReportData4.CONFED_NAME, tblReportData4.[Email Address] "
strSQL = strSQL & "INTO tblTemp1 "
strSQL = strSQL & "FROM tblReportData4 INNER JOIN tblTrusts "
strSQL = strSQL & "ON tblReportData4.DIST_NAME = tblTrusts.DIST_NAME "
strSQL = strSQL & "WHERE (((tblTrusts.DIST_NAME)= '" & strTrustName & "'));"

dbs.TableDefs.Refresh
For Each tdf In dbs.TableDefs
If tdf.Name = "tblTemp1" Then
DoCmd.DeleteObject acTable, tdf.Name
Forms!frmMainMenu.[txtStatus] = "Deleting temporary table."
DoCmd.RepaintObject acForm, "frmMainMenu"
Exit For
End If
Next

DoCmd.RunSQL strSQL
lngRecordCount = DCount("[Existing NPC]", "tblTemp1")

If lngRecordCount > 0 Then
strSQL = "SELECT tblTemp1.[Email Address] " & _
"FROM tblTemp1 " & _
"GROUP BY tblTemp1.[Email Address];"
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
.MoveLast
intEmailCount = .RecordCount
.MoveFirst
For intX = 1 To intEmailCount
strEmail = .Fields(0)
With rstExport
'.AddNew
'![CAT_BASE_DESC] = strTrustName
'.Update
.AddNew
![CAT_BASE_DESC] = Null
.Update
DoCmd.OpenQuery "qrySelectedReport"
intRecordCount = .RecordCount
'If intRecordCount > 0 Then
.AddNew
!BRAND = Null
.Update
.AddNew
![B1 Saving] = DLookup("[SumOfB1 Saving]", "qryCounts")
![B1 Annual Saving] = DLookup("[SumOfB1 Annual Saving]", "qryCounts")
![B2 Saving] = DLookup("[SumOfB2 Saving]", "qryCounts")
![B2 Annual Saving] = DLookup("[SumOfB2 Annual Saving]", "qryCounts")
![B3 Saving] = DLookup("[SumOfB3 Saving]", "qryCounts")
![B3 Annual Saving] = DLookup("[SumOfB3 Annual Saving]", "qryCounts")
.Update
'End If
End With
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "tblExport", "U:\Reports\" & strTrustName, True
Forms!frmMainMenu.[txtStatus] = "Creating spreadsheet for " & strTrustName & "."
DoCmd.RepaintObject acForm, "frmMainMenu"
DoCmd.CopyObject , strTrustName, acTable, "tblExport"
DoCmd.SendObject acSendTable, strTrustName, "MicrosoftExcel(*.xls)", "aziz.rasul@pasa.nhs.uk", "", "", strTrustName & " - Costing Savings Report", strBodyText, False, ""
DoCmd.DeleteObject acTable, strTrustName
Forms!frmMainMenu.[txtStatus] = "Emailing spreadsheet for " & strTrustName & "."
DoCmd.RepaintObject acForm, "frmMainMenu"
.MoveNext
intRecipients = intRecipients + 1
Next intX
End With
rst.Close
intReports = intReports + 1
End If
rstTrust.MoveNext
Loop