Блог

Главная - Вопросы по программированию - Применяйте код VBA только к электронным письмам, содержащим «строку» в теме

Применяйте код VBA только к электронным письмам, содержащим «строку» в теме

#excel #vba #outlook

Вопрос:

Я использую код, который отлично работает — цель состоит в том, чтобы отправлять информацию из Outlook в Excel, чтобы я мог отфильтровать ее и автоматизировать работу.

Проблема в том, что код VBA выполняется для всех полученных электронных писем, и я хочу выполнить его только для электронных писем с темой, начинающейся с «EK».

Я уже пробовал использовать функцию InStr, как показано ниже, но она не работает:

 If InStr(xMailItem.Subject, "EK") = 0 Then
   Exit Sub
End If

Куда мне следует поместить эту строку кода?

 Private Sub GMailItems_ItemAdd(ByVal Item As Object)

    Dim xMailItem As Outlook.MailItem
    Dim xExcelFile As String
    Dim xExcelApp As Excel.Application
    Dim xWb As Excel.Workbook
    Dim xWs As Excel.Worksheet
    Dim xNextEmptyRow As Integer
    Dim linhas As Variant, i As Integer
    Dim linhaInicial As Long
    Dim numeroCaracteresAssunto As Integer
    Dim assuntoEmail As String
    Dim k As Integer
           
    On Error Resume Next
    If (Item.Class <> olMail) Then Exit Sub
    Set xMailItem = Item
    
    xExcelFile = "EXCELFILEPATH.xlsx"
    If IsWorkBookOpen(xExcelFile) = True Then
        Set xExcelApp = GetObject(, "Excel.Application")
        Set xWb = GetObject(xExcelFile)
        If Not xWb Is Nothing Then xWb.Close True
    Else
        Set xExcelApp = New Excel.Application
    End If
                              
    Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
    Set xWs = Sheets.Add
    numeroCaracteresAssunto = Len(xMailItem.Subject)
    assuntoEmail = Right(xMailItem.Subject, numeroCaracteresAssunto - 16)
    xWs.Name = UCase(assuntoEmail)
    xNextEmptyRow = xWs.Range("B" amp; xWs.Rows.Count).End(xlUp).Row   1
    linhaInicial = 1
    
    With xWs
        linhas = Split(xMailItem.Body, vbNewLine)
        
        For i = 0 To UBound(linhas)
            Cells(linhaInicial   i, 1).Value = linhas(i)
            linhaInicial = linhaInicial   1
        Next
        
        For k = 1 To i

            xWs.Range("B" amp; k).FormulaLocal = "=SEERRO(ÍNDICE($A$1:$A$999;MENOR(SE(ÉNÚM(LOCALIZAR(""PC"";$A$1:$A$999));CORRESP(LIN($A$1:$A$999);LIN($A$1:$A$999)));" amp; k amp; "));"""")"
            xWs.Range("B" amp; k).FormulaArray = xWs.Range("B" amp; k).Formula
        
        Next k
    End With
End Sub

Комментарии:

1. Если вы хотите перехватить Subject значения, начинающиеся с заданной строки , почему бы не использовать Left функцию вместо InStr , которая будет просматривать подстроку в любом месте темы — примечание, которое InStr возвращает индекс , указывающий, где в строке найдено совпадение, если таковое имеется.

Ответ №1:

Instr не чувствителен к регистру.

 If InStr(UCase(xMailItem.Subject), UCase("EK")) = 0 Then

Или UCase или LCase .

В обеих частях, или вы можете столкнуться с опечаткой «eK».

Метки: ,