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
