仅将 VBA 代码应用于主题中包含“字符串”的电子邮件

Question

我使用的代码效果很好 - 目的是将信息从 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" & 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" & 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)));" & k & "));"""")"
            xWs.Range("B" & k).FormulaArray = xWs.Range("B" & k).Formula
        
        Next k
    End With
End Sub

Answer 1

Instr

区分大小写。

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

UCase

或

LCase

。

在这两个部分上，否则您可能会遇到“eK”拼写错误。