Jump to content
Fórum Script Brasil
  • 0
Sign in to follow this  
davidmgbr

Duvida codigo VBA planilha excel

Question

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

Share this post


Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

Cloud Computing


  • Forum Statistics

    • Total Topics
      148393
    • Total Posts
      643786
×
×
  • Create New...