Импорт данных из Outlook в Excel

Question

В настоящее время я разрабатываю макрос / надстройку для Excel, чтобы импортировать электронные письма из Outlook.

Когда я тестировал электронную почту, которая удовлетворяла всем установленным мной условиям, она работала простохорошо.

Однако, когда я тестировал более одного электронного письма, я получал ошибку «Подпись вне диапазона».

Я прочитал мой код слева направо и вправо, чтобыосталось, но я не могу выяснить, что я сделал неправильно.

Вот код, который у меня есть до сих пор (извините за грязный код, я вычистлю его после того, как все будет работать гладко).

Sub GetDataFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
'Dim LR As Long
Dim dbf As Worksheet
Dim ar() As String
ReDim ar(0 To i)

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox)
Set dbf = Sheets("DBF")
'LR = dbf.Range("A" & Rows.Count).End(xlUp).Row + 1
i = 0

For Each OutlookMail In Folder.Items
ar() = Split(OutlookMail.Body, ",")
    If InStr(OutlookMail.Subject, "Exportation of purchase order") > 0 Then
        For Each Item In ar
            Range("batch_reference").Offset(i, 0).Value = Left(ar(i), WorksheetFunction.Find("-", ar(i), 1) - 1)
            Range("batch_reference").Offset(i, 0).Columns.AutoFit
            i = i + 1
        Next Item
    End If
Next OutlookMail

    Columns("A:A").Select
    dbf.Range("$A$1:$A$100").RemoveDuplicates Columns:=1, Header:=xlYes
    dbf.Sort.SortFields.Clear
    dbf.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("DBF").Sort
        .SetRange Range("A2:A100")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Выделенная строка с ошибкой «Range (« batch_reference »). Offset (i, 0) .Value = Left (ar (i), WorksheetFunction.Find (" - ", ar (i)), 1) - 1) "

Понимаете, что мне не хватает?

Заранее спасибо!

Answer 1

Когда вы создаете массив ar, он будет массивом 0..n каждый раз .Таким образом, хотя i будет указывать на нужный элемент массива первого почтового элемента, при обработке второго почтового элемента ar снова является массивом на основе 0, но i указывает на следующую строку влист, который будет намного больше, чем 0.

Предложите что-то вроде:

 Range("batch_reference").Offset(i, 0).Value = Left(Item, WorksheetFunction.Find("-", Item, 1) - 1)

Или, возможно:

Range("batch_reference").Offset(i, 0).Value = Split(Item, "-")(0)