Hi,
I had a command shown below which was working fine but upgraded to 2016 outlook and Access and now outlook opens but doesn't open a new email and does not send.
I was wondering if anyone has any suggestions what the issue is?
Private Sub Command108_Click()
Dim myDefPrt As String
'get current default printer.
myDefPrt = Application.Printer.DeviceName
' change the printer
Set Application.Printer = Application.Printers("PDFCreator")
' do your printing here.........
Printer.ColorMode = acPRCMColor
Printer.ColorMode = acPRCMColor
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.PrintOut acSelection
'then reset default.
Set Application.Printer = Application.Printers(myDefPrt)
TWait = Time
TWait = DateAdd("s", 30, TWait)
Do Until TNow >= TWait
TNow = Time
Loop
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = [Invoicing Email Address]
.CC = ""
.BCC = ""
.Subject = "Invoice" & [Job No] & " , for Purchase Order" & [PO No]
.Body = "Please find attached to this email your invoice I" & [Job No] & " . For reference, your purchase order number is " & [PO No] & ". Regards, Caldervale Group Accounts"
.Attachments.Add "\\CS1\Data\1. Database\New FIHT System with email Invoicing\Invoices\Invoice.pdf"
.Attachments.Add "\\CS1\Data\1. Database\New FIHT System with email Invoicing\Invoices\FIHT Flyer.pdf"
.Display 'or use .Send
.ReadReceiptRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Dim Msg, Style, Title
Msg = "Email is ready for review... " & Chr(13) & Chr(10) & "Press OK to continue."
Style = vbOKOnly + vbInformation
Title = "Open Issues List"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If [Invoice Sent].Value = 0 Then
[Invoice Sent].Value = -1
End If
Me.Refresh
End Sub
I had a command shown below which was working fine but upgraded to 2016 outlook and Access and now outlook opens but doesn't open a new email and does not send.
I was wondering if anyone has any suggestions what the issue is?
Private Sub Command108_Click()
Dim myDefPrt As String
'get current default printer.
myDefPrt = Application.Printer.DeviceName
' change the printer
Set Application.Printer = Application.Printers("PDFCreator")
' do your printing here.........
Printer.ColorMode = acPRCMColor
Printer.ColorMode = acPRCMColor
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.PrintOut acSelection
'then reset default.
Set Application.Printer = Application.Printers(myDefPrt)
TWait = Time
TWait = DateAdd("s", 30, TWait)
Do Until TNow >= TWait
TNow = Time
Loop
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = [Invoicing Email Address]
.CC = ""
.BCC = ""
.Subject = "Invoice" & [Job No] & " , for Purchase Order" & [PO No]
.Body = "Please find attached to this email your invoice I" & [Job No] & " . For reference, your purchase order number is " & [PO No] & ". Regards, Caldervale Group Accounts"
.Attachments.Add "\\CS1\Data\1. Database\New FIHT System with email Invoicing\Invoices\Invoice.pdf"
.Attachments.Add "\\CS1\Data\1. Database\New FIHT System with email Invoicing\Invoices\FIHT Flyer.pdf"
.Display 'or use .Send
.ReadReceiptRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Dim Msg, Style, Title
Msg = "Email is ready for review... " & Chr(13) & Chr(10) & "Press OK to continue."
Style = vbOKOnly + vbInformation
Title = "Open Issues List"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If [Invoice Sent].Value = 0 Then
[Invoice Sent].Value = -1
End If
Me.Refresh
End Sub
