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>
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>