Code for sending via Lotus
Hi,
the main problem with Lotus is the separation of multiple reciepients.
If you use more than one emailaddress at once you have to use an array for TO,CC,.... so that it will be displayed correctly in your send items.
Have a look at this snipplet. I used it to send cases to different supporters and added different attachments.
It worked fine for me.
___________________________________________________________________________
’ Check if the format of the emailaddress is correct und change the format to Variant, so that Lotus can work correctly
___________________________________________________________________________
Public Function EmailAdressenCheck(check)
Dim EmailAdresses(), Platz_komma(24) As Variant
Dim anz_at, anz_komma, i, j
'anz_at = Number @-signs; anz_komma = numbers of commata as separator for more than one address
If check = "NO" Then
anz_at = 0
Else
anz_at = 0
anz_komma = 0
j = 0
‚Count how many reciepients enumeration with @-sign und seperator
For i = 1 To Len(check)
If Mid(check, i, 1) = "@" Then anz_at = anz_at + 1
If Mid(check, i, 1) = "," Then
anz_komma = anz_komma + 1
Platz_komma(j) = i
j = j + 1
End If
Next i
'Error routines
If anz_at < 1 Then
ReDim EmailAdresses(0)
MsgBox "Format of the Emailaddress is wrong"
EmailAdresses(0) = "Error"
EmailAdressenCheck = EmailAdresses
Exit Function
Else
If anz_komma < anz_at - 2 Then
ReDim EmailAdresses(0)
MsgBox "Wrong seperator between the emaliaddresses! Please use Comma"
EmailAdresses(0) = " Error "
EmailAdressenCheck = EmailAdresses
Exit Function
Else
If anz_komma = anz_at Then
ReDim EmailAdresses(0)
MsgBox " Check the emailaddresses, at least one @-sign is missing!"
EmailAdresses(0) = " Error "
EmailAdressenCheck = EmailAdresses
Exit Function
End If
End If
End If
s = 1
e = 0
End If
'Redim of the Variant fields, so that LOTUS gets the right number.
If anz_at = 0 Then
ReDim EmailAdresses(anz_at)
EmailAdresses(0) = " "
Else
ReDim EmailAdresses(anz_at - 1)
For i = 0 To anz_at - 1
If i = anz_at - 1 Then
EmailAdresses(i) = Mid(check, s, Len(check) - s + 1)
Else
e = Platz_komma(i) - s
EmailAdresses(i) = Mid(check, s, e)
s = Platz_komma(i) + 1
End If
Next i
End If
EmailAdressenCheck = EmailAdresses
End Function
___________________________________________________________________________
’ Send via Lotus
___________________________________________________________________________
Public Function SendNotesMail(Subject As String, Attachment As Variant, Recipient As Variant, Recipient2 As Variant, BodyText As String, SaveIt As Boolean, anz_attachments)
'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim i
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your password
'Session.Initialize ("805125538333")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string or using above password you can use other mailboxes.
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.Sendto = Recipient
If Len(Recipient2(0)) > 1 Then
MailDoc.copyto = Recipient2
End If
MailDoc.Subject = Subject
MailDoc.Body = BodyText
MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it
If anz_attachments > 0 Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
For i = 0 To anz_attachments - 1
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment(i), "Attachment")
Next i
MailDoc.CreateRichTextItem ("Attachment")
End If
'Send the document
MailDoc.Posteddate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.Send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Function^
___________________________________________________________________________
’ Procedur to send mail
___________________________________________________________________________
Private Sub Senden_Click()
Dim Empfaenger, Empf_Rueck
Dim S_Att() As Variant
Dim S_TO, S_CC, anz_att
If IsNull(Me.AMS_CC) Then Me.AMS_CC = ""
If IsNull(Me.IBM_cc) Then Me.IBM_cc = ""
'AMS and IBM are the reciepient of the calls
If Me.AMS_send Then
Empfaenger = EmailAdressenCheck(Me.AMS_to)
If Empfaenger(0) = "Fehler" Then
Me.AMS_to.SetFocus
Exit Sub
End If
Empf_Rueck = Empfaenger
S_TO = Empf_Rueck
If Me.AMS_CC > "" Then
Empfaenger = EmailAdressenCheck(Me.AMS_CC)
If Empfaenger(0) = "Fehler" Then
Me.AMS_CC.SetFocus
Exit Sub
End If
Empf_Rueck = Empfaenger
S_CC = Empf_Rueck
Else
Empfaenger = EmailAdressenCheck("NO")
Empf_Rueck = Empfaenger
S_CC = Empf_Rueck
End If
'Path for the templates to attach
If Path_AMS = "" Or IsNull(Path_AMS) Then
set_global_variablen
End If
anz_att = 0
'Chek if case for Bestellung exists
x = FileExists(Me.AMS_ATT)
If x Then anz_att = anz_att + 1
If Not IsNull(Me.Anhang1_Anforderung) Then anz_att = anz_att + 1
If anz_att > 0 Then
If anz_att = 1 Then
ReDim S_Att(0)
If Not IsNull(Me.AMS_ATT) Then S_Att(0) = Path_AMS & Me.AMS_ATT
If Not IsNull(Me.Anhang1_Anforderung) Then S_Att(0) = Me.Anhang1_Anforderung
Else
ReDim S_Att(1)
S_Att(0) = Me.AMS_ATT
S_Att(1) = Me.Anhang1_Anforderung
End If
Else
ReDim S_Att(0)
S_Att(0) = " "
End If
x = SendNotesMail(Me.Subject, S_Att, S_TO, S_CC, Me.Body, True, anz_att)
End If
If Me.IBM_send Then
Empfaenger = EmailAdressenCheck(Me.IBM_to)
If Empfaenger(0) = "Fehler" Then
Me.IBM_to.SetFocus
Exit Sub
End If
Empf_Rueck = Empfaenger
S_TO = Empf_Rueck
If Me.IBM_cc > "" Then
Empfaenger = EmailAdressenCheck(Me.IBM_cc)
If Empfaenger(0) = "Fehler" Then
Me.IBM_cc.SetFocus
Exit Sub
End If
Empf_Rueck = Empfaenger
S_CC = Empf_Rueck
Else
Empfaenger = EmailAdressenCheck("NO")
Empf_Rueck = Empfaenger
S_CC = Empf_Rueck
End If
anz_att = 0
'same for IBM Cases
x = FileExists(Me.IBM_ATT)
If x Then anz_att = anz_att + 1
If Not IsNull(Me.Anhang1_Anforderung) Then anz_att = anz_att + 1
If anz_att > 0 Then
If anz_att = 1 Then
ReDim S_Att(0)
If Not IsNull(Me.IBM_ATT) Then S_Att(0) = Path_AMS & Me.IBM_ATT
If Not IsNull(Me.Anhang1_Anforderung) Then S_Att(0) = Me.Anhang1_Anforderung
Else
ReDim S_Att(1)
S_Att(0) = Me.IBM_ATT
S_Att(1) = Me.Anhang1_Anforderung
End If
Else
ReDim S_Att(0)
S_Att(0) = " "
End If
x = SendNotesMail(Me.Subject, S_Att, S_TO, S_CC, Me.Body, True, anz_att)
End If
End Sub
