仅将 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”错字。