在子字符串数组中搜索特定字符串（VBA）

Question

我正在编写代码来处理传入的电子邮件。大多数方面都工作正常；然而，日期的处理给我带来了一些麻烦。我在 Module1 中定义的 EvaluateDate 函数无法正常工作。当我运行它时没有错误，只是没有输出。 Tabl 是子字符串数组。传入的电子邮件按行分成子字符串。因此，基本上数组的每个索引都是电子邮件中的一行。我希望搜索特定月份，然后为一月指定“01/”，依此类推。传入电子邮件的日期为“2011 年 10 月 20 日星期四”，并且希望在“10/20/11”处理。一切都是 String 类型。任何帮助将不胜感激。如果您需要更多其他代码来确定问题的根源，请告诉我。谢谢。

在 Sheet 1 代码中，

Public Sub CommandButton1_Click()

Dim olApp As New Outlook.Application
Dim olExp As Outlook.Explorer
Dim olSel As Outlook.Selection
Dim myArray(8) As String
Dim Line As Long, Addr1 As String
Dim Tabl, str As String
Dim index As Integer
Dim I As Integer, x As Integer, N As Integer, j As Integer

Sheets("EditData").Select
Columns("D:D").NumberFormat = "@"
'Selection.NumberFormat = "@"

On Error Resume Next
 ' Getting the messages selection
Set olApp = Outlook.Application
Set olExp = olApp.ActiveExplorer
Set olSel = olExp.Selection
 ' Checking if there is at least one message selected
If olSel.Count < 1 Then
    MsgBox "No message selected", vbExclamation, "Error"
    Exit Sub
End If
With Sheets("EditData")
     ' Retrieving the first avaible row to put message in
    Line = .Range("D65000").End(xlUp).Row + 1
     ' looping through message
    For x = 1 To olSel.Count
        DoEvents
        Erase myArray
        mybody = Replace(olSel.Item(x).body, Chr(13), "")

        ' Splitting the message body into an array of substrings,
        ' using the "line feed" characters as separators
        mybody = Replace(mybody, Chr(10) & Chr(10), Chr(10))
        Tabl = Split(mybody, Chr(10))
        For Each Item In Tabl
            Item = Replace(Item, Chr(10), "")
            Item = Application.Clean(Item)
        Next Item

        ' Looping through these substrings
        For I = 0 To UBound(Tabl)

            ' Date Received Start
            If LCase(Left(Tabl(I), 4)) = "sent" Then
                m = Module1.EvaluateDate(Tabl)
                .Cells(Line, 2) = m
            End If
       Next I
     Next X
   End With
 End Sub

在 Module1 中，

 'Function to determine the month, day, and year in this format mm/dd/yy
    Public Function EvaluateDate(Tabl As Variant) As Variant
    For I = 0 To UBound(Tabl)
        If InStr(1, Tabl(I), "January", 1) > 0 Then
            m = "01/"
        End If
        If InStr(1, Tabl(I), "February", 1) > 0 Then
            m = "02/"
        End If
        If InStr(1, Tabl(I), "March", 1) > 0 Then
            m = "03/"
        End If
        If InStr(1, Tabl(I), "April", 1) > 0 Then
            m = "04/"
        End If
        If InStr(1, Tabl(I), "May", 1) > 0 Then
            m = "05/"
        End If
        If InStr(1, Tabl(I), "June", 1) > 0 Then
            m = "06/"
        End If
        If InStr(1, Tabl(I), "July", 1) > 0 Then
            m = "07/"
        End If
        If InStr(1, Tabl(I), "August", 1) > 0 Then
            m = "08/"
        End If
        If InStr(1, Tabl(I), "September", 1) > 0 Then
            m = "09/"
        End If
        If InStr(1, Tabl(I), "October", 1) > 0 Then
            m = "10/"
        End If
        If InStr(1, Tabl(I), "November", 1) > 0 Then
            m = "11/"
        End If
        If InStr(1, Tabl(I), "December", 1) > 0 Then
            m = "12/"
        End If
    Next I
    EvaluateDate = m
End Function

Answer 1

有几点：

1) 在 VBA 函数中，您需要使用函数名称分配返回值。您的代码缺少这样的内容：

EvaluateDate = m

此外，EvaluateDate 的返回值可以是字符串：

Public Function EvaluateDate(Tabl As Variant) As String

2）您的 Tabl 变量被声明为 Variant，这实际上是正确的，但您认为它是字符串。

Dim Tabl, str As String

这实际上意味着：

Dim Tabl As Variant, str As String

您可以共享 Dim 语句，但不能共享声明。

另请注意，您尚未在按钮代码中声明“mybody”或“m”。

3) 当您的代码输入适当的 If 语句并在月份名称上找到匹配项时，您应该退出循环。我会像这样重写 EvaluateDate 中的 For 循环：

For i = 0 To UBound(Tabl)
    Select Case True
    Case InStr(1, Tabl(i), "January", 1) > 0
      m = "01/"
    Case InStr(1, Tabl(i), "February", 1) > 0
      m = "02/"
    Case InStr(1, Tabl(i), "March", 1) > 0
      m = "03/"
    Case InStr(1, Tabl(i), "April", 1) > 0
      m = "04/"
    Case InStr(1, Tabl(i), "May", 1) > 0
      m = "05/"
    Case InStr(1, Tabl(i), "June", 1) > 0
      m = "06/"
    Case InStr(1, Tabl(i), "July", 1) > 0
      m = "07/"
    Case InStr(1, Tabl(i), "August", 1) > 0
      m = "08/"
    Case InStr(1, Tabl(i), "September", 1) > 0
      m = "09/"
    Case InStr(1, Tabl(i), "October", 1) > 0
      m = "10/"
    Case InStr(1, Tabl(i), "November", 1) > 0
      m = "11/"
    Case InStr(1, Tabl(i), "December", 1) > 0
      m = "12/"
    End Select
  Next i

4）您的代码中有这一行：

Dim olApp As New Outlook.Application

这将导致自动实例化（请参阅 http://www.cpearson.com/excel/classes.aspx 了解为什么这不好）。只需声明该变量，因为您稍后已经在代码中创建了它。

5) 在按钮代码中，您循环遍历电子邮件的每一行，但随后将整个电子邮件传递给 EvaluateDate 函数并再次循环遍历每一行。因此，如果我的数学正确，那么当您只需要循环 n 次时，您将在电子邮件中循环 n*n 次。这真的是你想要的吗？