Fout op windows server 2012R2 Methode To van object_mailitem is mislukt

[HWV]

Sub Save_Mail_Werkblad_Inhoud_in_de_Body()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
 
Dim Naam
Set Naam = Worksheets("orderbon").Range("D10")

Dim Vertegenwoordiger
Set Vertegenwoordiger = Worksheets("orderbon").Range("P4")

Dim Bestandsnaam
Set Bestandsnaam = Worksheets("orderbon").Range("N3")

 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$15"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    ActiveWindow.DisplayGridlines = False
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.118110236220472)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .CenterHorizontally = True
        .CenterVertically = True
        .PrintComments = xlPrintNoComments
        .Orientation = xlLandscape
        .Draft = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    
 ReplaseVreemdeTekens
 
 c00 = "P:\Ingevulde bonnen\Offerte aanvragen\" & Bestandsnaam & "" & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
 c01 = ThisWorkbook.FileFormat

c03 = "<table border=0 bgcolor=#FFFFF0#>"

 sn = Sheets("Orderbon").Range("B15:S56") '.UsedRange
 For j = 1 To UBound(sn)

c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
 c03 = c03 & "</table><P></P><P></P>"


ThisWorkbook.Sheets("Orderbon").Copy

Application.DisplayAlerts = False
  With ActiveWorkbook
      .SaveAs "P:\automatisering\Temp\orderbon.xlsx", 51
      .Close 0
    End With
    
    Workbooks.Open "P:\automatisering\Temp\orderbon.xlsx"

 With ActiveWorkbook
.SaveAs c00, c01
 .Close False
End With

 With CreateObject("Outlook.Application").createitem(0)
 [COLOR="#FF0000"].To [/COLOR]= [P6]
 .CC = [P7]
 .Subject = [N3]
 .attachments.Add c00
 .HTMLBody = [N3] & c03
 .Send '.Display
End With

MsgBox "Beste " & Vertegenwoordiger & "," & vbCrLf & "" & vbCrLf & "Uw Offertebon voor de klant " & Naam & " is opgeslagen," & vbCrLf & "deze vind u terug in P:\Ingevulde bonnen\Offerte aanvragen" & vbCrLf & ""

BestandenSluiten

 End Sub

Deze code grbuik ik om een bestand te mailen, werkt goed.
enkel op onze terminalserver niet meer.
We zijn nu over naar windows server 2012R2, maar daar geef hij nu een foutmelding op"P6" Methode To van object_mailitem is mislukt

Het lijk zo simpel, maar iemand een idee waar het fout gaat. Zeker dat het enkel op de terminalserver verkeerd gaat

HWV

 

[edmoor]

Doe .Display en .Send allebei eens en ook in die volgorde.

 

[HWV]

.To = [P6]

Bedankt voor je reactie, maar ik krijg nog steeds de zelfde melding

.To = [P6]

HWV

 

[edmoor]

Was een probeerseltje, dat is ooit een fout geweest in het Outlook object bij het gebruik van .HTMLBody

 

[HWV]

een oplossing gevonden

Ik heb het draaiend gekregen met de volgende, misschien niet logisch maar werkt wel.

c04 = [P6]
c05 = [P7]
c06 = [N3]

With CreateObject("Outlook.Application").createitem(0)
.To = c04
.CC = c05
.Subject = c06
.attachments.Add c00
.HTMLBody = c06 & c03
'.Display
.Send
End With

Wat nu wel voor doet dat het lang duurt (30 seconden voor dat ik op zenden kan drukken), maar hij verzend wel na goed keuring te hebben geven in outlook.

HWV

 

[edmoor]

Vreemd inderdaad. Maar die vraag om goedkeuring kan je ook vermijden.
Daar zijn meerdere methoden voor. Zelf gebruik ik de registersleutels:
https://www.msoutlook.info/question/883