VBA split file based and send splitted file in separate emails

[harmless92]

Hello,
I am trying to build a VBA code to split one source Excel file in several excel files (the "master file"). The master file file contains 2 sheets. The sheet 1 contains the data and the sheet 2 contains a table with 2 columns: columns 1 with the supplier number and column 2 with the email address of the recipient.
The sheet 1 contains the data with several columns with many rows. I need to extract the data of the sheet 1 in as many different excel files as number of supplier number I have in the source file (which is in column A of the source file).
Each excel file generated by the macro should be stored in a folder and each excel file stored in the folder should be named by the "suppliernumber.xlsx". Then in a second step, each excel file should be sent to an email address stored in a sheet 2. As an example, the excel file 30020909.xlsx is referenced in column 1 of the table in sheet 2 of the master file and in the column there is an email address: YYY@YYY.com. So by clicking on the macro the file should be attached and sent to this address email and the same for all files in the folder. My code is not working and I am wondering if you could help or guide me to find a solution ? Thank you in advance.

Sheet 1 data structure and example:
Col A / Col B / Col C / Col D
supplierNumber / Article number / Forecast P1 / Forecast P2
654021 / 707-2001193 / 340000 / 455000
30020909 / 707-2000479 / 43000 / 340000

Sheet data structure and example:
Col A / Col B
supplierNumber / email
654021 / XXX@XXX.fr
30020909 / YYY@YYY.com


My Code:

Sub SplitAndEmailFiles()
    Dim wsData As Worksheet, wsEmails As Worksheet
    Dim dict As Object, key As Variant
    Dim lastRow As Long, i As Long
    Dim supplierNumber As String, email As String
    Dim wbNew As Workbook
    Dim folderPath As String
    
    Set wsData = ThisWorkbook.Sheets(1) ' Assuming data is in the first sheet
    Set wsEmails = ThisWorkbook.Sheets(2) ' Assuming email addresses are in the second sheet
    Set dict = CreateObject("Scripting.Dictionary")
    folderPath = "C:\Yoplait_Forecast\" ' Change to your folder path
    
    ' Read supplier numbers and their emails into a dictionary
    With wsEmails
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastRow ' Assuming row 1 has headers
            dict(.Cells(i, 1).Value) = .Cells(i, 2).Value
        Next i
    End With
    
    ' Create individual files for each supplier number
    With wsData
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastRow ' Assuming row 1 has headers
            supplierNumber = .Cells(i, 1).Value
                If dict.exists(supplierNumber) Then
                    email = dict(supplierNumber)
            
            ' Check if the workbook for this supplier already exists, if not, create it
            If Not WorkbookExists(folderPath & supplierNumber & ".xlsx") Then
                Set wbNew = Workbooks.Add
                .Rows(1).Copy Destination:=wbNew.Sheets(1).Rows(1) ' Copy headers
                wbNew.SaveAs fileName:=folderPath & supplierNumber & ".xlsx"
                wbNew.Close SaveChanges:=False
            End If
            
            ' Add data row to the supplier's workbook
            AppendDataRow folderPath & supplierNumber & ".xlsx", .Rows(i)
        Next i
    End With
    
    ' Email the files
    For Each key In dict
        SendEmailWithAttachment dict(key), folderPath & key & ".xlsx", "Subject here", "Body here"
    Next key

End Sub

Function WorkbookExists(fileName As String) As Boolean
    Dim ff As Integer
    On Error Resume Next
    ff = FreeFile()
    Open fileName For Input Lock Read As #ff
    If Err.Number = 0 Then
        WorkbookExists = True
        Close #ff
    Else
        WorkbookExists = False
    End If
    On Error GoTo 0
End Function

Sub AppendDataRow(fileName As String, dataRow As Range)
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = Workbooks.Open(fileName)
    Set ws = wb.Sheets(1)
    ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, dataRow.Columns.Count).Value = dataRow.Value
    wb.Close SaveChanges:=True
End Sub

Sub SendEmailWithAttachment(toEmail As String, attachmentPath As String, subjectText As String, bodyText As String)
    Dim outlookApp As Object
    Dim outlookMail As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    
    With outlookMail
        .To = toEmail
        .Subject = subjectText
        .Body = bodyText
        .Attachments.Add (attachmentPath)
        .Send
    End With
End Sub