Duvida codigo VBA planilha excel

[davidmgbr]

Boa Tarde amigos ,

Sou iniciante no VBA poderia me ajudar no codigo abaixo por favor.

Esse codigo uso para enviar emails com anexos diferente para cada contato , o problema que da e se por exemplo o nome do arquivo for 399 e da outra pessoa for 398 ele entende esse '39' e envia dois arquivos para cada contato , como faco para que o codigo busque somente o nome exato do arquivo.

 

Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet: Set ws = Sheets("Emails")
    Dim enviad As String
    enviad = 0
    'Path do anexo ao email a ser enviado
    Set Rng = ws.Range(Range("J2"), ws.Range("J" & Rows.Count).End(xlUp))
    For Each cell In Rng
        Rw = cell.Row
        Path = cell.Value
        If Path <> "" Then
            'Obtem a informacao do path
            Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
            'obtem o  nome do arquivo na (Coluna A)
            strNomeArq = cell.Offset(0, -9).Value
            ' endereco de Email
            ToNome = cell.Offset(0, -5).Value
            ccTo = RecpList
            'Obtem o nome
            FirstNme = cell.Offset(0, -7).Value
            Surname = cell.Offset(0, -6).Value
            'faz loop através do caminho dos arquivos ver se existe
            ClientFile = Dir(Path & "\*.*")
            Do While ClientFile <> ""
                If InStr(ClientFile, strNomeArq) > 0 Then
                    AttachFile = Path & "\" & ClientFile
                    MailBody = "Prezado " & FirstNme & vbNewLine & vbNewLine _
                               & "Segue em anexo uma cópia do Holerite  " & Dte _
                               & vbNewLine & vbNewLine _
                               & "Nome do Arquivo: " & cell.Offset(0, -9).Value _
                               & vbNewLine & _
                               "Departamento: " & cell.Offset(0, -8).Value _
                               & vbNewLine & _
                               "Funcionario: " & FirstNme & " " & Surname _
                               & vbNewLine & _
                               "Obrigado" & _
                               Signature    '(asinatura)
                    Set OutApp = CreateObject("Outlook.Application")
                    Set OutMail = OutApp.CreateItem(o)
                    With OutMail
                        .Subject = "Holerite de - " & Dte
                        .To = ToNome
                        .cc = ccTo
                        .Body = MailBody
                        .Attachments.Add (AttachFile)
                        '.Display
                        .Send
                        enviad = enviad + 1
                    End With
                    Set OutMail = Nothing
                    Set OutApp = Nothing
                    RecpList = ""
                End If
                ClientFile = Dir
            Loop
        End If
    Next
    If enviad = 0 Then
    MsgBox "Nenhum email enviado", 64, "AVISO"
    Else
    MsgBox enviad & " enviados da sua lista de emails!", 0, "SUCESSO"
    End If