Excel VBA для прикрепления файлов с определенным текстом в подпапках «основной» папки - PullRequest
Новая
       11

Excel VBA для прикрепления файлов с определенным текстом в подпапках «основной» папки

0 голосов
/ 18 октября 2018

Я пытаюсь создать код для этого:

-Отправить электронное письмо, если в ячейке есть определенное значение.Если это так, процедура для следующей строки (проверьте!) -Каждое письмо должно иметь настраиваемый текст в зависимости от значения ячейки (проверьте!)

Теперь я хочу, чтобы к этому письму прикреплялся один или несколько файлов.которые содержат конкретное значение.Например, допустим, у меня есть c: \ folder \ folder1 и c: \ folder \ folder2.Я хочу, чтобы почта вложила все файлы в folder1 и folder2, в которых есть слово «FULL».Я покажу, что у меня есть.Кто-нибудь может мне помочь?Заранее спасибо.

PS: файлы всегда *. * Pdf

Мой код 

Sub mail()



Dim LastEntry As String, LastRow As Integer

LastRow = 50

    LastEntry = ""
    For i = 6 To LastRow
        If Cells(i, 1).Value <> "" Then

Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    If Cells(i, 1).Value = "Manutenção Preventiva" Then
    strbody = Range("E1").Value & "<br>" & _
              " <br>" & _
              "VTEXT TEXT2 " & Cells(i, 7).Value & ", a partir das " & Cells(i, 6).Value & " horas." & _
              " <br>" & _
              " <br>" & _
              "OTHER TEXT" & _
              " <br>" & _
              "<br>" & _
              "PEOPLE(s):<br>" & _
              Cells(i, 27).Value & "<br>" & _
              Cells(i, 28).Value & "<br>" & _
              Cells(i, 29).Value & "<br>" & _
              Cells(i, 30).Value & "<br>" & _
              " </B>"
     End If

    If Cells(i, 1).Value = "TEXT3" Then
    strbody = Range("E1").Value & "<br>" & _
              " <br>" & _
              "VBLABLA " & Cells(i, 7).Value & ", a partir das " & Cells(i, 6).Value & " horas." & _
              " <br>" & _
              " <br>" & _
              "BLABLA2" & _
              " <br>" & _
              "<br>" & _
              "PEOPLE(s):<br>" & _
              Cells(i, 27).Value & "<br>" & _
              Cells(i, 28).Value & "<br>" & _
              Cells(i, 29).Value & "<br>" & _
              Cells(i, 30).Value & "<br>" & _
              " </B>"
     End If


 On Error Resume Next

    With OutMail
        .Display
        .To = Cells(i, 21).Value
        .CC = Cells(i, 22).Value & "
        .BCC = ""
        .Subject = Cells(i, 26).Value
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

End If

    Next i


End Sub
...