Hi
I've just upgraded from 2003 to 2010 and split the database into front and back-end.
The following code now produces "Run-time error ‘3251’: Operation is not supported for this type of object" and stops at .Attachments.Add rst!ConsolidatedFile (highlighted red):
Private Sub Command0_Click()
Dim rst As dao.Recordset
Dim stEmail As String
Dim stDate As String
Dim stPath As String
Dim stSubject As String
Dim salPosition As String
Dim stBody As String
Dim HTML As String
Dim OLApp As Object 'New Outlook.Application
Dim OLMsg As Object 'Outlook.MailItem
Dim oShell As Object
Dim salName As String
Dim salMessage As String
Dim salFooter As String
Dim salPhone As String
Dim salCell As String
Dim salFax As String
On Error Resume Next
Set OLApp = CreateObject("Outlook.Application") 'GetObject(, "Outlook.Application") 'Gets Outlook if open
If err.Number > 0 Then
Set oShell = CreateObject("WScript.Shell") 'Opens instance of Outlook
oShell.Run "outlook" 'Outlook is not open so open it
Else
'Outlook is already open
End If
On Error GoTo 0
frmCreatingEmails.Visible = True
Set rst = CurrentDb.OpenRecordset("Select * from tblEmailList", dbOpenDynaset)
salMessage = Nz(Me.SalutationMessage, "")
salName = Nz(Me.SalutationName, "")
salFooter = Nz(Me.SalutationFooter, "")
salCell = Nz(Me.Cell, "")
salPhone = Nz(Me.Phone, "")
salPosition = Nz(Me.Position, "")
salFax = Nz(Me.Fax, "")
If rst.EOF Then
frmCreatingEmails.Visible = False
MsgBox "Nothing to send, please check the dates", vbOKOnly, "Warning"
Else
Do While Not rst.EOF
'stName = rst.Fields("ClientName").Value ' Glynne, this field is not used at all. CC
stPath = rst.Fields("Filepath").Value
stDate = rst.Fields("InvoiceEndDate").Value
stEmail = rst.Fields("EmailAddress").Value
stSubject = "The Buying Group Fuelcard Invoice for month ending " & stDate
HTML = "<html><body><font face = Tahoma size = 2>"
HTML = HTML & "<p>Hi there</p>"
HTML = HTML & "<p>Please find attached your Fuelcard invoice for the month ending" & " " & stDate & "." & "</p>"
HTML = HTML & "<p>Our current Terms of Trade took effect from 1/10/11. </p>"
HTML = HTML & "<p>Also, save 10 to 50 basis points on each foreign exchange transaction compared to the big banks. Very low Telegraphic Transfer fees. </p>"
HTML = HTML & "<p>Kind regards</p>"
HTML = HTML & "<p><font color = #C00000 face = Calibri size = 3><b>" & salName & "</font><font color = #595959 face = Calibri size = 3>" & salPosition & "</font></b><br><font color = #595959 face = Calibri size = 2>THE BUYING GROUP LIMITED<br>P: " & salPhone & " | F:" & salFax & "</font></p>"
HTML = HTML & "<p><font color = #595959 face = Calibri size = 2><b>" & salMessage & "</b></font></p>"
HTML = HTML & "<p><font size = 1>" & salFooter & "</font></p>"
HTML = HTML & "</font></body></html>"
stBody = HTML
Set OLMsg = OLApp.CreateItem(0)
With OLMsg
.Recipients.Add stEmail
.Subject = stSubject
.Attachments.Add stPath
If Nz(rst!ConsolidatedFile, "X") <> "X" Then
.Attachments.Add rst!ConsolidatedFile
End If
If Nz(rst!ExcelFile, "X") <> "X" Then
.Attachments.Add rst!ExcelFile
End If
'Set body format to HTML
.BodyFormat = 2 'olFormatHTML
.HTMLBody = stBody
.Save
End With
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
frmCreatingEmails.Visible = False
End If
DoCmd.Close acForm, Me.Name
End Sub
I've just upgraded from 2003 to 2010 and split the database into front and back-end.
The following code now produces "Run-time error ‘3251’: Operation is not supported for this type of object" and stops at .Attachments.Add rst!ConsolidatedFile (highlighted red):
Private Sub Command0_Click()
Dim rst As dao.Recordset
Dim stEmail As String
Dim stDate As String
Dim stPath As String
Dim stSubject As String
Dim salPosition As String
Dim stBody As String
Dim HTML As String
Dim OLApp As Object 'New Outlook.Application
Dim OLMsg As Object 'Outlook.MailItem
Dim oShell As Object
Dim salName As String
Dim salMessage As String
Dim salFooter As String
Dim salPhone As String
Dim salCell As String
Dim salFax As String
On Error Resume Next
Set OLApp = CreateObject("Outlook.Application") 'GetObject(, "Outlook.Application") 'Gets Outlook if open
If err.Number > 0 Then
Set oShell = CreateObject("WScript.Shell") 'Opens instance of Outlook
oShell.Run "outlook" 'Outlook is not open so open it
Else
'Outlook is already open
End If
On Error GoTo 0
frmCreatingEmails.Visible = True
Set rst = CurrentDb.OpenRecordset("Select * from tblEmailList", dbOpenDynaset)
salMessage = Nz(Me.SalutationMessage, "")
salName = Nz(Me.SalutationName, "")
salFooter = Nz(Me.SalutationFooter, "")
salCell = Nz(Me.Cell, "")
salPhone = Nz(Me.Phone, "")
salPosition = Nz(Me.Position, "")
salFax = Nz(Me.Fax, "")
If rst.EOF Then
frmCreatingEmails.Visible = False
MsgBox "Nothing to send, please check the dates", vbOKOnly, "Warning"
Else
Do While Not rst.EOF
'stName = rst.Fields("ClientName").Value ' Glynne, this field is not used at all. CC
stPath = rst.Fields("Filepath").Value
stDate = rst.Fields("InvoiceEndDate").Value
stEmail = rst.Fields("EmailAddress").Value
stSubject = "The Buying Group Fuelcard Invoice for month ending " & stDate
HTML = "<html><body><font face = Tahoma size = 2>"
HTML = HTML & "<p>Hi there</p>"
HTML = HTML & "<p>Please find attached your Fuelcard invoice for the month ending" & " " & stDate & "." & "</p>"
HTML = HTML & "<p>Our current Terms of Trade took effect from 1/10/11. </p>"
HTML = HTML & "<p>Also, save 10 to 50 basis points on each foreign exchange transaction compared to the big banks. Very low Telegraphic Transfer fees. </p>"
HTML = HTML & "<p>Kind regards</p>"
HTML = HTML & "<p><font color = #C00000 face = Calibri size = 3><b>" & salName & "</font><font color = #595959 face = Calibri size = 3>" & salPosition & "</font></b><br><font color = #595959 face = Calibri size = 2>THE BUYING GROUP LIMITED<br>P: " & salPhone & " | F:" & salFax & "</font></p>"
HTML = HTML & "<p><font color = #595959 face = Calibri size = 2><b>" & salMessage & "</b></font></p>"
HTML = HTML & "<p><font size = 1>" & salFooter & "</font></p>"
HTML = HTML & "</font></body></html>"
stBody = HTML
Set OLMsg = OLApp.CreateItem(0)
With OLMsg
.Recipients.Add stEmail
.Subject = stSubject
.Attachments.Add stPath
If Nz(rst!ConsolidatedFile, "X") <> "X" Then
.Attachments.Add rst!ConsolidatedFile
End If
If Nz(rst!ExcelFile, "X") <> "X" Then
.Attachments.Add rst!ExcelFile
End If
'Set body format to HTML
.BodyFormat = 2 'olFormatHTML
.HTMLBody = stBody
.Save
End With
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
frmCreatingEmails.Visible = False
End If
DoCmd.Close acForm, Me.Name
End Sub