Email each new workbook of a split workbook - vba

Question

I have code that splits a workbook based on a condition. I want to email each of those new workbooks to different people.
When I run the macro, it splits the workbook and puts all the worksheets where I want them. When I try to send I only send 1 email.
Sub savesheetsSend()
Dim ws As Worksheet
Dim Filetype As String
Dim Filenum As Long
Dim wb As Workbook
Dim FolderName As String
Dim open_book As Workbook
Set outmail = CreateObject("outlook.application")
Set outmsg = outmail.createitem(0)
Set wb = Application.ThisWorkbook
'create directory to save each sheet in
FolderName = "C:\Users\jpenn\Desktop" & "\" & wb.Name
MkDir FolderName
On Error Resume Next
'save each sheet as workbook in directory
For Each ws In wb.Worksheets
If ws.Range("A1") = 1 Then
Filetype = ".xlsm": Filenum = 52
ws.Copy
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & Filetype
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=Filenum
End If
Next
'send all new workbooks to email address in CELL("B1")
For Each open_book In Application.Workbooks
If open_book.Name <> ThisWorkbook.Name Then
With outmsg
.Subject = ActiveWorkbook.Name & " payroll data"
.To = ActiveWorkbook.ActiveSheet.Range("b1").Value
.body = "I will get to this later"
.Attachments.Add Application.ActiveWorkbook.FullName
.send
End With
open_book.Close
End If
Next
End Sub

Answer 1

Try it this way... Tested
Option Explicit
Sub savesheetsSend()
Dim Ws As Worksheet
Dim Filetype As String
Dim xFile As String
Dim Filenum As Long
Dim Wb As Workbook
Dim FolderName As String
Dim Open_Book As Workbook
Dim OutMsg As Object
Dim OutMail As Object
Set OutMail = CreateObject("outlook.application")
Set Wb = Application.ThisWorkbook
'create directory to save each sheet in
FolderName = "C:\Users\jpenn\Desktop" & "\" & Wb.Name
MkDir FolderName
'save each sheet as workbook in directory
For Each Ws In Wb.Worksheets
If Ws.Range("A1") = 1 Then
Filetype = ".xlsm": Filenum = 52
Ws.Copy
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & Filetype
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=Filenum
Set OutMsg = OutMail.createitem(0)
With OutMsg
.Subject = Ws.Name & " payroll data"
.To = ActiveSheet.Range("b1").Value
.Body = "I will get to this later"
.Attachments.Add (xFile)
.Display
End With
ActiveWorkbook.Close
End If
Next
End Sub