Отправить Авто-письмо с дубликатом Word / ID - PullRequest
Новая
       9

Отправить Авто-письмо с дубликатом Word / ID

0 голосов
/ 25 апреля 2018

Ниже приведен мой код для автоматической отправки электронной почты, но при этом каждый идентификатор отправляется с 1 электронным письмом.
Мне нужно сначала скомпилировать повторяющийся идентификатор перед отправкой автоматической электронной почты.
В качестве примера ниже приведен тег службыдубликат ID.Извините, не могу поставить все коды здесь, потому что я получаю ошибку.

enter image description here

For i = 2 To lRow
    If OOW.Sheets("WORKING FILE").Range("W" & i) = "YES" And _
    OOW.Sheets("WORKING FILE").Range("B" & i) = "Ruz" And _
    OOW.Sheets("WORKING FILE").Range("Y" & i) = "" Then

    Set rng = Nothing
    Set rngTilte = Nothing
    On Error Resume Next
    Set rngTilte = OOW.Sheets("WORKING FILE").Range("D1:X1").SpecialCells(xlCellTypeVisible)
    Set rng = OOW.Sheets("WORKING FILE").Range("D" & i & ":" & "X" & i). _
    SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set olNs = OutApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetFolderFromID(EntryID, StoreID)
    Set myTasks = Fldr.items

    For Each olMail In myTasks

    If (InStr(1, olMail.Subject, Cells(i, 4), vbTextCompare) > 0) And _
    (InStr(1, olMail.Subject, Cells(i, 6), vbTextCompare) > 0) Then

с функцией ниже 

    Function RangetoHTML(rngTilte As Range, rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim NR As Long  ' Next Aavailable Row

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    ' Amended to paste two ranges
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        rngTilte.Copy
        .Cells(1, 1).PasteSpecial Paste:=8
        .Cells(1, 1).PasteSpecial xlPasteValues, , False, False
        .Cells(1, 1).PasteSpecial xlPasteFormats, , False, False
        ' Add second range
        NR = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        rng.Copy
        .Cells(NR, 1).PasteSpecial Paste:=8
        .Cells(NR, 1).PasteSpecial xlPasteValues, , False, False
        .Cells(NR, 1).PasteSpecial xlPasteFormats, , False, False
        ' End of add second range
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

Редактировать 1

Я пытаюсь с этим, и это работает. 

Dim Criteria As Range
Set Criteria = OOW.Sheets("WORKING FILE").Cells(i, 4)
OOW.Sheets("WORKING FILE").Columns("D:D").AutoFilter Field:=4, Criteria1:=Criteria.Value
OOW.Sheets("WORKING FILE").Columns("Z:Z").AutoFilter _
Field:=26, Criteria1:=""

Set rng = Nothing
Set rngTilte = Nothing
On Error Resume Next
Set rngTilte = OOW.Sheets("WORKING FILE").Range("D1:X" & lRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

А теперь я столкнулся с другой проблемой.
Как я могу перейти к следующему идентификатору, если после фильтрации текущего идентификатораи я считаю, что столбец поддержки пуст.

1 Ответ

0 голосов
/ 25 апреля 2018

Есть несколько способов сделать это - я предполагаю, что вы хотите отправить 1 электронное письмо для каждого идентификатора услуги, но перечислить все части (в данном случае 3)

Самый простой способ - сортировкасписок по идентификатору службы, затем сохраните идентификатор службы, с которой вы работаете, и проверяйте строки, пока идентификатор службы не изменится.Затем это дает вам все строки / части, которые должны быть включены в это электронное письмо.

Если вы не хотите сортировать список, вы можете сохранить «готовые» идентификаторы услуг (в Словареили исключенная строка («| A | B |» означает, что «C» не было выполнено, так как «| C |» не найден InStr)) и либо Filter для каждого нового идентификатора службы, затем используйте .SpecialCells для просмотрав отображаемых строках или (неэффективно) просматривайте до конца таблицы и добавляйте любые данные из строк с одинаковым идентификатором службы

...