Hoe kan ik ervoor zorgen dat ik via Lotus notes een mail kan versturen vanuit excel naar meerdere personen?
ik gebruik onderstaande code
Option Explicit
' code voor het mailen van het actieve werkblad naar het adres uit cel A2
' met bijlage als naam uit cel A1
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "Y:" 'deze constante kun je zelf aanpassen (pad moet wel bestaan)
Const stSubject As String = "lalala" 'Onderwerp van de E-mail
Const vaMsg As Variant = "Kind Regards" & vbCrLf & vbCrLf & vbCrLf
Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"
Sub Send_Active_Sheet()
Dim stFileName As String 'tekst uit cel A1 aktief werkblad wordt bestandsnaam
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim stEmailAddress As String 'tekst uit cel A2 aktief werkblad is het e-mailadres
'Kopieer het actieve werkblad naar een nieuw tijdelijk werkboek met de naam uit cel A1.
With ActiveSheet
If Range("A1") <> "" Then
.Copy
stFileName = .Range("A1").Value 'hier wordt bestandsnaam uit cel A1 gehaald
Else
MsgBox "Geen email-adres ingevuld"
Exit Sub 'Als er niets in A1 staat dan niets doen
End If
End With
' het pad (stPath) wordt bepaalt in het Constant declaratie gedeelte
stAttachment = stPath & "\" & stFileName & ".xls"
'Saven en afsluiten tijdelijk werkboek (bijlage).
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'haal het e-mailadres uit cel A2 van het actieve sheet op.
With ActiveSheet
If Range("A3") <> "" Then
stEmailAddress = .Range("A3").Value 'hier wordt het e-mail adres uil cel A3 gehaald.
Else
MsgBox "Geen emailadres ingevuld!"
Exit Sub 'Als er niets in A2 staat dan niets doen
End If
End With
'Maak de lijst van ontvangers. "naar(uit cel A2 actief werkblad)", "naar 2e persoon"
vaRecipients = VBA.Array(stEmailAddress) '("eerste ontvanger" , "tweede ontvanger")
'Bepaal de Lotus Notes COM's Objecten.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Als Lotus Notes niet open is open dan het mail-gedeelte ervan.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Maak de e-mail en de bijlage.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Voeg de gegevens toe aan de gemaakte e-mail eigenschappen.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
'.CopyTo =
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.send 0, vaRecipients
End With
'Verwijder het tijdelijk werkboek.
Kill stAttachment
'Verwijder objecten uit het geheugen.
'Set noEmbedObject = Nothing
'Set noAttachment = Nothing
'Set noDocument = Nothing
'Set noDatabase = Nothing
'Set noSession = Nothing
End Sub
ik gebruik onderstaande code
Option Explicit
' code voor het mailen van het actieve werkblad naar het adres uit cel A2
' met bijlage als naam uit cel A1
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "Y:" 'deze constante kun je zelf aanpassen (pad moet wel bestaan)
Const stSubject As String = "lalala" 'Onderwerp van de E-mail
Const vaMsg As Variant = "Kind Regards" & vbCrLf & vbCrLf & vbCrLf
Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"
Sub Send_Active_Sheet()
Dim stFileName As String 'tekst uit cel A1 aktief werkblad wordt bestandsnaam
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim stEmailAddress As String 'tekst uit cel A2 aktief werkblad is het e-mailadres
'Kopieer het actieve werkblad naar een nieuw tijdelijk werkboek met de naam uit cel A1.
With ActiveSheet
If Range("A1") <> "" Then
.Copy
stFileName = .Range("A1").Value 'hier wordt bestandsnaam uit cel A1 gehaald
Else
MsgBox "Geen email-adres ingevuld"
Exit Sub 'Als er niets in A1 staat dan niets doen
End If
End With
' het pad (stPath) wordt bepaalt in het Constant declaratie gedeelte
stAttachment = stPath & "\" & stFileName & ".xls"
'Saven en afsluiten tijdelijk werkboek (bijlage).
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'haal het e-mailadres uit cel A2 van het actieve sheet op.
With ActiveSheet
If Range("A3") <> "" Then
stEmailAddress = .Range("A3").Value 'hier wordt het e-mail adres uil cel A3 gehaald.
Else
MsgBox "Geen emailadres ingevuld!"
Exit Sub 'Als er niets in A2 staat dan niets doen
End If
End With
'Maak de lijst van ontvangers. "naar(uit cel A2 actief werkblad)", "naar 2e persoon"
vaRecipients = VBA.Array(stEmailAddress) '("eerste ontvanger" , "tweede ontvanger")
'Bepaal de Lotus Notes COM's Objecten.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Als Lotus Notes niet open is open dan het mail-gedeelte ervan.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Maak de e-mail en de bijlage.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Voeg de gegevens toe aan de gemaakte e-mail eigenschappen.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
'.CopyTo =
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.send 0, vaRecipients
End With
'Verwijder het tijdelijk werkboek.
Kill stAttachment
'Verwijder objecten uit het geheugen.
'Set noEmbedObject = Nothing
'Set noAttachment = Nothing
'Set noDocument = Nothing
'Set noDatabase = Nothing
'Set noSession = Nothing
End Sub