Jump to content
Fórum Script Brasil

davidmgbr

Membros
  • Content Count

    1
  • Joined

  • Last visited

Community Reputation

0 Neutro

About davidmgbr

  1. 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
×
×
  • Create New...