Macro aanpassen voor bestand dat al klaar staat.

[vrouw]

Ik wil na veel testen met ook andere scripts om te mailen toch onderstaande code gaan gebruiken.
Het enige dat erin aangepast moet worden is dat het bestand al klaarstaat in de C:\Temp\bestand.xls

Ik weet maar niet wat ik in deze (toch wel lange script) moet aanpassen dat ie tijdens dit script dus zelf niets hoeft op te slaan etc. maar slechts de bijlage toe moet voegen.
=> Belangrijk blijft wel dat de ontvanger uit Cel A2 en A3 worden gehaald!

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 = "C:\Temp"  '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"
 
 Application.DisplayAlerts = False
 
  '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

 

[vrouw]

Excuus, die was me ontschoten. andere had ik wel al afgesloten en bedankt.