Поиск массива подстрок для конкретной строки (VBA) - PullRequest
Новая
       14

Поиск массива подстрок для конкретной строки (VBA)

0 голосов
/ 07 ноября 2011

Я пишу код для обработки входящих писем.Большинство аспектов работают правильно;Однако обработка даты доставляет мне некоторые проблемы.Функция EvaluateDate, которую я определил в Module1, не работает должным образом.Нет ошибки при запуске, просто нет вывода.Tabl - это массив подстрок.Входящие электронные письма разбиты на подстроки построчно.Итак, в основном каждый индекс массива представляет собой строку из электронного письма.Я ищу для поиска конкретного месяца, а затем назначить "01 /" для января и так далее.Поступившие электронные письма как таковые "четверг, 20 октября 2011 года" и хотели бы быть обработаны до "20/10/11".Все имеет строковый тип.Любая помощь будет принята с благодарностью.Дайте мне знать, если вам нужно больше другого кода, чтобы определить источник проблемы.Спасибо.

В коде листа 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

1 Ответ

0 голосов
/ 07 ноября 2011

Несколько вещей:

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 и находит совпадение в названии месяца, вы должны выйтипетля.Я бы переписал цикл For в EvaluateDate следующим образом: 

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 раз.Это действительно то, что вы хотите?

...