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

Question

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

在工作表 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

在模块 1 中，

 '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 次。这真的是你想要的吗？