搜索特定字符串(VBA)的子字符串数组

时间:2011-11-07 17:02:53

标签: arrays string vba date substring

我正在编写处理传入电子邮件的代码。大多数方面都正常运作;但是,处理日期给我带来了一些麻烦。我在Module1中定义的EvaluateDate函数无法正常工作。运行时没有错误,没有输出。 Tabl是一个子串数组。传入的电子邮件按行分为子串。因此,基本上每个数组的索引都是来自电子邮件的一行。我希望搜索特定的月份,然后为1月分配“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

1 个答案:

答案 0 :(得分:0)

一些事情:

1)在VBA函数中,您需要使用函数名称指定返回值。您的代码缺少这样的内容:

EvaluateDate = m

此外,EvaluateDate的返回值可以是String:

Public Function EvaluateDate(Tabl As Variant) As String

2)你的Tabl变量被声明为Variant,它实际上是正确的,但你认为它是一个String。

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