Probleme beim Zugriff auf Outlook

  • VB6

    Probleme beim Zugriff auf Outlook

    Hallo zusammen,

    ich habe ein Probem beim zugriff auf Outlook.
    Ich erstelle ein Outlook objekt und rufe nacheinander seine Funktionen auf (siehe Code weiter unten)
    Das funktioniert auch wunderbar, nur wird beim Anlegen einer neuen Mail
    KEINE SIGNATUR angezeigt. Ich bekomme einfach eine "nackige" Mail.
    Weiß jemand, wie man die Signatur mit erstellen kann.

    mfg

    Franz

    <code>
    Dim NewMail As Outlook.MailItem
    Dim curRecipient As clsRecipient
    Dim curAttachment As clsAttachment
    Dim NewRecipient As Outlook.Recipient
    Dim NewAttachment As Outlook.Attachment

    Feedback.SetStatusMessage "Bitte warten ...", "Erstelle neue Mail"
    Set NewMail = MailConnection.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Items.Add(olMailItem)
    NewMail.Save


    'Select Case Mail.BodyType
    ' Case enmBodyType.btDefault
    '
    ' Case enmBodyType.btHTML
    ' NewMail.GetInspector.EditorType = olEditorHTML
    '
    ' Case enmBodyType.btRTF
    ' NewMail.GetInspector.EditorType = olEditorRTF
    '
    ' Case enmBodyType.btText
    ' NewMail.GetInspector.EditorType = olEditorText
    '
    ' Case Else
    ' Err.Raise 2393, "[komMA Mailsystem]", "Das in der Eigenschaft 'BodyType' angegebene Format wird von diesem Provider nicht unterstützt"
    '
    'End Select
    '
    'If Mail.ShowMail Then
    ' Feedback.SetStatusMessage "Bitte warten ...", "Öffne Mail"
    '
    ' NewMail.Display
    'End If

    Feedback.SetStatusMessage "Bitte warten ...", "Füge Empfänger hinzu (Hauptempfänger)"
    For Each curRecipient In Mail.Recipients
    Set NewRecipient = NewMail.Recipients.Add(curRecipient.MailAdress)
    NewRecipient.Type = olTo
    Next

    Feedback.SetStatusMessage "Bitte warten ...", "Füge Empfänger hinzu (CC)"
    For Each curRecipient In Mail.CC
    Set NewRecipient = NewMail.Recipients.Add(curRecipient.MailAdress)
    NewRecipient.Type = olCC
    Next

    Feedback.SetStatusMessage "Bitte warten ...", "Füge Empfänger hinzu (BCC)"
    For Each curRecipient In Mail.BCC
    Set NewRecipient = NewMail.Recipients.Add(curRecipient.MailAdress)
    NewRecipient.Type = olBCC
    Next

    For Each curAttachment In Mail.Attachments
    Feedback.SetStatusMessage "Bitte warten ...", "Füge Dateianhänge ein (" + ExtractFilename(curAttachment.Path) + ")"
    If Trim(curAttachment.DisplayName) = "" Then
    NewMail.Attachments.Add curAttachment.Path, olByValue
    Else
    NewMail.Attachments.Add curAttachment.Path, olByValue, , curAttachment.DisplayName
    End If
    Next

    Feedback.SetStatusMessage "Bitte warten ...", "Füge Nachrichtentext ein"
    If Mail.BodyType = enmBodyType.btText Then
    NewMail.HTMLBody = Mail.MsgText + IIf(NewMail.HTMLBody = "", NewMail.Body, NewMail.HTMLBody)
    ElseIf Mail.BodyType = enmBodyType.btHTML Then
    NewMail.Body = Mail.MsgText + NewMail.Body
    Else
    Err.Raise 2030, "[komMA Mailsystem]", "Dieser Provider unterstützt den angegebenen BodyType nicht"
    End If

    Feedback.SetStatusMessage "Bitte warten ...", "Setzen des Betreffs"
    NewMail.Subject = Mail.Subject

    If Mail.AutoSend Then
    Feedback.SetStatusMessage "Bitte warten ...", "Sende Mail"

    NewMail.Send
    End If

    If Mail.KillMailAfterEnd Then
    Feedback.SetStatusMessage "Bitte warten ...", "Lösche Mail"

    NewMail.Delete
    End If

    If Mail.SaveInDrafts Then
    Feedback.SetStatusMessage "Bitte warten ...", "Speichere Mail als Entwurf"

    NewMail.Save
    End If
    </code>