Lotus notes --> meerdere ontvangers

Status
Niet open voor verdere reacties.

schockie

Gebruiker
Lid geworden
13 apr 2008
Berichten
7
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
 
Schockie,

kijk ook bij je andere vraag hierover bij post 7:
http://www.helpmij.nl/forum/showthread.php?t=269121
Nu wordt er ook naar de geadresseerde in cel A3 gemaild.

Code:
Option Explicit
' code voor het mailen van het actieve werkblad naar het adres uit cel A2 en A3
' met bijlage als naam uit cel A1
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "D:"  'deze constante kun je zelf aanpassen (pad moet wel bestaan)
Const stSubject As String = "nieuwe planning"  'Onderwerp van de E-mail

Const vaMsg As Variant = "Het wekelijks planningsoverzicht."

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 stEmailAddress1 As String  'tekst uit cel A2 aktief werkblad is het e-mailadres
  Dim stEmailAddress2 As String  'tekst uit cel A3 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
        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("A2") <> "" Then
        stEmailAddress1 = .Range("A2").Value   'hier wordt het e-mail adres uil cel A2 gehaald.
    Else
        Exit Sub   'Als er niets in A2 staat dan niets doen
    End If
    If Range("A3") <> "" Then
        stEmailAddress2 = .Range("A3").Value   'hier wordt het e-mail adres uil cel A3 gehaald.
    End If
  End With
  
  'Maak de lijst van ontvangers.  "naar(uit cel A2 actief werkblad)", "naar (uit A3 actief werkblad"
  vaRecipients = VBA.Array(stEmailAddress1, stEmailAddress2) '("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 = vaCopyTo
    .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
 
  MsgBox "Het planningsoverzicht is gemaild.   ", vbInformation
End Sub

Koosl
(bij mij werkt de code)
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan