Split WB in two new WBs, attach both and email

[malabares]

Hi all,

just going through fantastic's Ron de Bruin range to html function, etc.
Works good, however, I'd like to attach not one workbook, but several ones into same email.

In other words, let's say my active workbook has three sheets:
- Sheet 1
- Sheet 2
- Sheet 3

I want to split this workbook in two, and attach both of them in same email:
- Copy/paste Sheet 1 and Sheet 2 in one new workbook and attach.
- Copy/paste Sheet 3 in another new workbook and attach.
- Both in same email.

I've tried to add another temporary FilePath for this second workbook, but definetely doesn't work.

Anyone?

Thanks in advance,

 

[EFANYoutube]

Hey Malabares
Please can you supply a copy of your code so we can adjust it for you

 

[malabares]

Hi @EFANYoutube,

thanks for quick reply. See below:

1. These are my WS:

2. And this VBA from Ron de Bruin. Tried to tweak it by adding a new TempFilePath, TempFileName, and FileExtStr as well, but doesn't fly-

Thanks for your support, bit newbie here.

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFilePath2 As String
Dim TempFileName As String
Dim FileExtStr As String
Dim TempFileName2 As String
Dim FileExtStr2 As String
Dim strbody As String
Dim signature As String


Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = Sheets("01. Productos").Range("B2:O13")
Set wb1 = ActiveWorkbook
Set wb2 = ActiveWorkbook


If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

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

 'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Stock - PA " & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    'TempFilePath = Environ$("temp2") & "\"
    'TempFileName2 = "Stock - MP_MA " & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    'FileExtStr2 = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
  wb2.SaveCopyAs TempFilePath2 & TempFileName2 & FileExtStr2


strbody = "Hola," & "<br><br>"
            
            
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Let signature = OutMail.htmlbody

With OutMail
    .to = ""
    .CC = ""
    .BCC = ""
    .Subject = "OL" & " " & Format(Now, "dd/mm")
    .htmlbody = strbody & RangetoHTML(rng) & "<br><br>" & "Salutacions," & vbNewLine & signature
    .Attachments.Add TempFilePath & TempFileName & FileExtStr & TempFilePath2 & TempFileName2 & FileExtStr2 (this definetely doesn't work).
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0

 'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr
   'Kill TempFilePath2 & TempFileName2 & FileExtStr2


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

Set OutMail = Nothing
Set OutApp = Nothing

End Sub