AW: Das ist ein NOVELL Mail-Thema
26.10.2010 19:22:41
Heinz
Hallo NoNet
Habe in diesen Forum folgenden Code gefunden.
Muss in aber noch anpassen.
Macht noch schwierigkeiten.
Danke
Heinz
Option Explicit
Sub Send_with_Groupwise()
'Original Unknown
'modified by Ramses
'Sollte ab Groupwise GroupWise 6.5.6 up2 (21.05.2007) laufen
'Frühere Versionen unterstüzen VBA nur rudimentär
'd.h. Groupwise kann nur die Mail annehmen,
'aber die Mail wird nicht automatisch versandt
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 mailSubject As String, mailAttachment As String, mailRecipient As String, mailBodytext _
As String
'Dim Qe As Index
'Variabler Text
'mailBodytext = InputBox("Bitte Mailtext eingeben", "Groupwise Mail", "")
'Variabler Text aus Zelle
mailBodytext = Range("B90") & " " & Range("Q5") & "Schicht " & Range("U5")
If mailBodytext = "" Then
MsgBox "Mailversand abgebrochen"
Exit Sub
End If
On Error GoTo Errorhandling
'Betreffzeile füllen
mailSubject = "Betreff"
'mailSubject = Range("B1")
'Mailempfänger
mailRecipient = "Niemand@niemand.tu"
'mailRecipient = Range("C1")
'Ü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(mailRecipient)
'Qe = MsgBox("Möchten Sie eine Datei als Anhang versenden ?", vbQuestion + vbYesNo + _
vbDefaultButton2, "Mail mit Anhang")
'If Qe = vbYes Then
mailAttachment = Application.GetOpenFilename("Alle Dateien (*.*), *.*)")
If StrPtr(mailAttachment) = 0 Then
Set objAttachments = objMessage.Attachments
Set objAttachment = objAttachments.Add(mailAttachment)
End If
'End If
With objMessage
.Subject = mailSubject
.Bodytext = mailBodytext
End With
'Mail senden
Set objMessageSent = objMessage.Send
ErrorExit:
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 ErrorExit
End Sub