Array van Sheets

[nando64]

Beste Leden,

Ik wil van een bestand met bijvoorbeeld 10 werkbladen er 3 selecteren en deze als een apart bestand als bijlage in een emailbericht versturen.

Met dank aan Ron de Bruin gebruik ik zijn code om excelbestanden als bijlagen in een emailbericht te versturen. Ik kom er alleen niet achter hoe ik deze code om kan bouwen om een bepaald aantal sheets in een tijdelijk bestand op te slaan en te versturen.

Ik had zelf het idee om de sheets in een array te benoemen (zie code), maar dit werkt niet. De tussenliggende tabbladen in het originele bestand zijn gewoon aanwezig en ook nodig voor andere doeleinden.

Wie kan mij helpen?

Sub Test()
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb1 = ThisWorkbook.Sheets(Array("Blad1", "Blad5", "Blad9"))

    TempFilePath = Environ$("temp") & "\"
    TempFileName = " " & wb1.Name & " "
    'FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
     With OutMail
        .to = "helpmij@helpmij.nl"
        .CC = ""
        .BCC = ""
        .Subject = "Hier komt het onderwerp"
        .Body = ""
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .Display
    End With
    On Error GoTo 0

     Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

      
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
End Sub

 

[HSV]

Bv.

Sub hsv()
Dim nm As String
Sheets(Array("Blad1", "Blad3")).Copy
 ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Date
  nm = ActiveWorkbook.FullName
    With CreateObject("Outlook.Application").CreateItem(0)
    .to = "adres@aanbieder.com"
    .Subject = "blabla"
    .attachments.Add nm
    .display 'or send
    End With
  ActiveWorkbook.Close False
Kill nm
End Sub

 

[nando64]

Harry,

Bedankt, code werkt perfect!

Nando