Автоматическая рассылка файлов адресатам в Outlook

Function GetCopy(NameShop As String)
    Dim oWS As Worksheet
    Dim LastRow As Long
    Dim i As Long
    
    Set oWS = oWB.Sheets("Òàáëèöà ïîñòàâùèêîâ")
    
    With oWS
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        
        For i = 2 To LastRow
            If .Cells(i, 5) = NameShop Then
                GetCopy = oWS.Cells(i, 6)
                Exit For
            End If
        Next i
    End With
    
    Set oWS = Nothing
End Function

Private Sub cbSaveSend_Click()
    Dim oTemp_WB As Workbook
    Dim oSaved_WB As Workbook
    Dim wbName As String
    Dim sNameTo As String
    Dim sNameShop As String
    Dim i As Long
    
    With Me.lbBooks
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Set oTemp_WB = Application.Workbooks(.Column(0, i))
                sNameTo = oTemp_WB.ActiveSheet.Cells(3, 2)
                sNameShop = oTemp_WB.ActiveSheet.Cells(2, 2)
                wbName = sNameShop & " " & Split(sNameTo, "/")(0) & " " & oTemp_WB.ActiveSheet.Cells(4, 2)
                
                Set oSaved_WB = Saved_File(oTemp_WB, wbName)
                
                Call Create_Mail(GetAdress(sNameTo), GetBody(sNameTo), wbName, GetCopy(sNameShop), oSaved_WB.Path & "\" & oSaved_WB.Name)
            End If
        Next
    End With
ufSelectBook.Hide
End Sub