Loop that creates attachment files from scratch

The files to create add up to over 100 (current code is just decoy emails before adapting to the main email list).

The code to create the attachment details makes the file and saves it for the first loop then throws an error:

data type mismatch

on the Windows(xm).Select line before the email code, which is in Christmas Email.xlsm, starts:

Sub EmailSend()
     
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Back End")
    Dim oa As Object
    Dim msg As Object
    FirstChartPath = ThisWorkbook.Path & "\Redacted.png" 
    ChartName = "redacted.png" 
    CurrentFile = "Christmas Email.xlsm"  
    Set xm = ThisWorkbook.Sheets("Back End").Range("J" & 9)
        
    Set oa = CreateObject("outlook.Application")
    Dim i As Integer
    Dim last_row As Integer
        
    last_row = sh.Range("J65536").End(xlUp).Row
        
    For i = 9 To last_row
        
        Workbooks.Add.SaveAs Workbooks(CurrentFile).Path & "\" & sh.Range("J" & 9)
        Windows("Christmas Email.xlsm").Activate
        Sheets("Template").Select
        Cells.Select
        Selection.Copy
        Application.CutCopyMode = False
        Selection.Copy
        Windows(xm).Select
        ActiveSheet.Paste
        Range("C5").Select
        Windows("Christmas Email.xlsm").Activate
        Set msg = oa.createitem(0)
        
        msg.To = sh.Range("H" & i).Value
        msg.Subject = sh.Range("E2").Value
        msg.HTMLBody = MESSAGE HERE
        'If sh.Range("H" & i).Value <> "" Then
            'msg.attachments.Add sh.Range("I" & i).Value
        'End If
        
        msg.display
         
        'msg.Send
         
    Next i
          
    ' MsgBox "Sent"
         
End Sub

I tried to record a macro but couldn't fit the loop around it.

Worksheet.Copy will create a new workbook without copy/paste.

Option Explicit

Sub EmailSend()
 
    Dim sh As Worksheet, wbTmpl As Workbook
    Dim oa As Object, msg As Object
    Dim last_row As Long, i As Long
    Dim folder As String, attachFile As String
    
    Set oa = CreateObject("outlook.Application")
    Set sh = ThisWorkbook.Sheets("Back End")
    folder = ThisWorkbook.Path & "\"
    
    With sh
        last_row = .Cells(.Rows.Count, "H").End(xlUp).Row
        If last_row < 9 Then
            MsgBox "No data in col H below row " & last_row, vbCritical
            Exit Sub
        End If
        For i = 9 To last_row
            If Len(.Range("H" & i).Value) > 0 Then
            
                ' create attachment
                attachFile = folder & sh.Range("J" & 9)
                ThisWorkbook.Sheets("Template").Copy
                ActiveWorkbook.Close savechanges:=True, Filename:=attachFile
   
                ' send email
                Set msg = oa.createitem(0)
                msg.To = .Range("H" & i).Value
                msg.Subject = .Range("E2").Value
                msg.HTMLBody = "MESSAGE HERE"
                msg.attachments.Add attachFile
                msg.display
                msg.Send
                
            End If
        Next i
    End With
      
    MsgBox i - 9 & " Emails Sent", vbInformation
     
End Sub