CDO Message Fields erweitern. X-MSMail-Priority X-Priority Important sowie Übermittlungsbestätigung keine Funktion

Sub CDO_config()
   '==This section provides the configuration information for the remote SMTP server.  
   sendusing = 2           '==Normally you will only change the server name or IP.  
   smtpserver = "xx.xx.xx.xx" '   
   smtpserverport = 25                            'Server port (typically 25)  
   '==End remote SMTP server configuration section==  

   Sender = "xxxxx@xxxx"             ' Absender E-mail adresse  
   SenderName = """xxxxxxxx" ' Absender Name"  
End Sub

   
Set objMessage = CreateObject("CDO.Message")  

Call CDO_config

  With objMessage.Configuration.Fields
    '==This section provides the configuration information for the remote SMTP server.  
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = sendusing           '==Normally you will only change the server name or IP.  
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver         'Name or IP of Remote SMTP Server  
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpserverport 'Server port (typically 25)  
    .Update
    '==End remote SMTP server configuration section==  
  End With
   
      ' ###################### Mail Senden  ######################  
    
    With objMessage
        .Subject = EMailbetreff
        .Sender = Sender   ' Absender  
        .FROM = SenderName ' Absendername  
        .BCC = Empfaenger
     
      
        .textBody = Mailtext
        .textBodyPart.ContentMediaType = "text/plain"  
        .textBodyPart.Charset = "ISO-8859-1"  
        .textBodyPart.ContentTransferEncoding = "quoted-printable"  
        
  
        ' Lesebestätigung Anfordern  
        .Fields("urn:schemas:mailheader:disposition-notification-to") = "user@test.de" 'ToDo: Type a valid e-mail address.  
        .Fields.Update
      
        
        'Set DSN options.  
        '    Name                   Value       Description  
        '    cdoDSNDefault             0       No DSN commands are issued.  
        '    cdoDSNNever               1       No DSN commands are issued.  
        '    cdoDSNFailure             2       Return a DSN if delivery fails.  
        '    cdoDSNSuccess             4       Return a DSN if delivery succeeds.  
        '    cdoDSNDelay               8       Return a DSN if delivery is delayed.  
        '    cdoDSNSuccessFailOrDelay  14      Return a DSN if delivery succeeds, fails, or is delayed.  
        .DSNOptions = cdoDSNSuccessFailOrDelay
        .DSNOptions = 14
        .DSNOptions.Update
        
       'Dringlichkeit einbinden  
       ' Prio  
        .Fields("urn:schemas:mailheader:X-MSMail-Priority") = "High" ' For Outlook 2003  
        .Fields("urn:schemas:mailheader:X-Priority") = 2 ' For Outlook 2003 also  
        .Fields("urn:schemas:httpmail:importance") = 2 ' For Outlook Express  
        .Fields.Update
     On Error Resume Next
     .Send