Macro email error

[brunorocha]

Hello, after i upgraded my PC from outlook2016 to 365(the app version), the following macro didn't create email anymore.
PS, if i disable the excel attachment the simptom disapers!!!
thanks in advance


MAcro...

Sub Save_and_PDF_online()


Dim WB1 As Workbook
Dim WB2 As Workbook
Dim xRg As Range
Dim PathStatusFile As String
Dim Departamento As String
PathStatusFile = "\\10.10.0.25\Public\Winprovit\DEP Tecnico\Status Propostas\Status Propostas 2018.xlsm"
If IsFileOpen(PathStatusFile) = False Then
Else
MsgBox PathStatusFile & " is already open."
End If
Dim PathSaveFile As String
'###Fili destination###
PathSaveFile = "C:\Users\bruno.rocha\OneDrive\Desktop\Propostas Buffer"

Set WB1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Template").Select
Range("G3:H3").Select
Selection.Copy
Workbooks.Open fileName:= _
PathStatusFile, ReadOnly:=False
ActiveWindow.Visible = True
Sheets("Resumo geral").Select
Set WB2 = ActiveWorkbook
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

ln01 = CLng(Mid(ActiveCell.Address, 4, 7))

WB1.Activate
Sheets("Template").Select
Range("G5:H5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("B" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("G2:H2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("C" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("C9:D9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("D" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("C10:D10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("E" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("C11:D11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("F" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("G9:H9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("G" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("G10:H10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("H" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("G11:H11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("I" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

WB1.Activate
Sheets("Template").Select
Range("H30").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Status Propostas 2018.xlsm").Activate
Sheets("Resumo geral").Select
Range("J" & ln01).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Range("K" & ln01).End(xlUp).Offset(1).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Enviado Cliente"
Range("L" & ln01).End(xlUp).Offset(1).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = Now

Application.DisplayAlerts = False

WB1.Activate
For Each xRg In Range("A15:A26")
If xRg.Value = "" Then
xRg.EntireRow.Hidden = True
Else
xRg.EntireRow.Hidden = False
End If
Next xRg
For Each xRg In Range("A6")
If xRg.Value = "" Then
xRg.EntireRow.Hidden = True
Else
xRg.EntireRow.Hidden = False
End If
Next xRg

Windows("Status Propostas 2018.xlsm").Activate
ActiveWorkbook.Save
ActiveWindow.Close


ThisWorkbook.BuiltinDocumentProperties("title") = Worksheets("Template").Range("G4").Text
ThisWorkbook.BuiltinDocumentProperties("subject") = Worksheets("Template").Range("C8").Text


Application.DisplayAlerts = False
ActiveWorkbook.SaveAs fileName:=PathSaveFile & Range("G3"), _
CreateBackup:=False
Application.DisplayAlerts = True


ChDir PathSaveFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
PathSaveFile & Range("G3") & " " & Range("G4"), Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.to = "financ@winpr.pt"
.CC = "bruno.rocha@winpr.pt"
.BCC = ""
.Subject = "#proposta# " & Range("G3") & " " & Range("G4") & ".pdf"
.Body = Range("A9") & Range("C9") & vbCr & Range("A10") & Range("C10") & vbNewLine & _
"Direcção: IT Services" & vbNewLine & _
"Departamento: " & Range("G6") & vbNewLine & _
"Manager: Bruno Rocha" & vbNewLine & _
vbNewLine
'After i disable the next link the email is created!!!
.attachments.Add PathSaveFile & Range("G3") & ".xlsm"
.attachments.Add PathSaveFile & Range("G3") & " " & Range("G4") & ".pdf"
.Display
'.Send
End With


Kill strPath & strFName
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing


End Sub