Attachment anhängen funktioniert nicht
28.08.2008 11:23:27
Ano
ich habe hier im Forum einen Artikel (https://www.herber.de/forum/archiv/636to640/t638281.htm#638285)
gefunden, der den Emailversand über GroupWise darstellt. Das VBA-Script funktioniert hervorragend. Allerdings nur, wenn ich kein Attachment anhänge.
Ich möchte eigentlich das aktiv geöffnete Excelfile als Anhang versenden. Allerdings kommt die Fehlermeldung "Objekt unterstützt die Eigenschaft oder Methode nicht 438".
Könnt ihr mir helfen? Vielen Dank :)
Grüsse vom Bodensee
Daniel
Script:
Private Sub CommandButton2_Click()
Dim olApp As Object
Dim objGroupWise As Object
Dim objAccount As Object
Dim objMessages As Object
Dim objMessage As Object
Dim objMailBox As Object
Dim objRecipients As Object
Dim objRecipient As Object
Dim objAttachment As Object
Dim objAttachments As Object
Dim objMessageSent As Variant
Dim Subject As String, Attachment As String, Recipient As String, Bodytext As String
Message = "Änderungsantrag" & Tabelle1.Range("S21").Value
On Error GoTo Errorhandling
Subject = "MZ-Änderungsantrag - " & Tabelle1.Range("S21").Value & " - " & Tabelle1. _
Projektnummer.Value
'Anhang deklarieren
Attachment = ActiveWorkbook
Recipient = Tabelle1.Range("Mail_LPC").Value
Bodytext = Message
'Übergabe an Groupwise
Set objGroupWise = CreateObject("NovellGroupWareSession")
Set objAccount = objGroupWise.Login
Set objMailBox = objAccount.MailBox
Set objMessages = objMailBox.Messages
Set objMessage = objMessages.Add("GW.MESSAGE.MAIL", "Draft")
Set objRecipients = objMessage.Recipients
Set objRecipient = objRecipients.Add(Recipient)
Set objAttachments = objMessage.Attachments
Set objAttachment = objAttachments.Add(Attachment)
With objMessage
.Subject = Subject
.Bodytext = Bodytext
End With
Set objMessageSent = objMessage.Send
ExitHere:
Set objGroupWise = Nothing
Set objAccount = Nothing
Set objMailBox = Nothing
Set objMessages = Nothing
Set objMessage = Nothing
Set objRecipients = Nothing
Set objAttachments = Nothing
Set objRecipient = Nothing
Set objAttachment = Nothing
Exit Sub
Errorhandling:
MsgBox Err.Description & " " & Err.Number
Resume ExitHere
End Sub