Как назначить список строк из диапазона Excel в переменную outlook vba?

Question

Как назначить список строк из диапазона Excel в переменную outlook vba?

[решение внизу]

У меня работает следующий сценарий VBA в Outlook.Я намерен извлечь список адресов электронной почты (строк) из листа Excel для сравнения отправителей.Но мне не удается, и поведение мне странно:

Sub OutlookExcel()

    'declare variables
    Dim xExcelFile As String
    Dim xExcelApp As Excel.Application
    Dim xWb As Excel.Workbook
    Dim xWs As Excel.Worksheet

    'declare xls file
    xExcelFile = "[path]\test1.xlsx"
    'open the xls file
    Set xExcelApp = CreateObject("Excel.Application")
    Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
    Set xWs = xWb.Sheets(1)

    ' get the email adresses. here i get into trouble
    Dim rng As Variant
    Set rng = xWs.Range("A2:A3")

    Debug.Print rng(1)
    Debug.Print rng(2)
    Debug.Print rng(3)
    Debug.Print rng(9)
    Debug.Print rng(10)
    Debug.Print rng(0)            
End Sub

, который возвращает

A2
A3
A4
A10

A1

с моими "адресами электронной почты" в test1.xlsx следующим образом:

обратите внимание, что я указал rng как две ячейки "A2: A3", но ячейки A1 до A10 содержатся.rng (100) возвращает пустую строку.

Я хотел бы иметь объект списка с индексами 1 и 2, содержащий "A2" и "A3".На втором шаге мне нужно, чтобы мой список содержал ячейку A2 до последней непустой ячейки столбца A.

EDIT

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

ключевая проблема заключается в том, что список адресов электронной почты, которые я получаю, кажется бесконечно длинным длядля каждого цикла:

Function Findstring(email As String, rng2 As Variant) As Integer
'returns -1 if email is not found in rng2, otherwise its index

Findstring = -1
Dim i As Integer
i = 1
For Each Item In rng2  'never stops, i ever increases => function doesnt return
    If email = Item Then
        Findstring = i
        Exit For
    End If
    i = i + 1
Next
End Function

, где массив rng2 - это список с электронными письмами, составленный ниже:

    Sub GetEMailsFolders(ByRef rng1 As Variant, ByRef rng2 As Variant, ByRef n As Variant)

        'declare variables
        Dim xExcelFile As String
        Dim xExcelApp As Excel.Application
        Dim xWb As Excel.Workbook
        Dim xWs As Excel.Worksheet

        'declare email & folder xls file
         xExcelFile = "C:\temp\temp.xlsx"
        'open the file
        Set xExcelApp = CreateObject("Excel.Application")
        Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
        Set xWs = xWb.Sheets(1)

        'extract folders (column A), emails (column O) and thir number
        n = xWs.Range(xWs.Range("A2"), xWs.Range("A2").End(xlDown)).Count  'works
        Set rng1 = xWs.Range(xWs.Range("A2"), xWs.Range("A2").Offset(n - 1, 0)) 'folder names
        Set rng2 = xWs.Range(xWs.Range("O2"), xWs.Range("O2").Offset(n - 1, 0)) 'emails
    End Sub

В самом конце мне нужна переменная рабочей области, содержащая (конечно) список, который я могу а) повторять через для каждого и б) индекс как список (1) до список (N)

[решение]

мой "хак" - перенаправить вариант на известную длину и назначить каждому элементу:

    n = xWs.Range(xWs.Range("A2"), xWs.Range("A2").End(xlDown)).Count ' works
    ReDim rng1(1 To n) As Variant
    For i = 1 To n
        rng1(i) = xWs.Cells(i + 1, 1)
        Debug.Print rng1(i), rng2(i)
    Next

теперь все идет гладко.Тем не менее я поражен этим вариантом поведения - или, может быть, я еще не понял его

Answer 1

Это то, что вы пытаетесь сделать?

Option Explicit
Sub OutlookExcel()
    'declare variables
    Dim xExcelFile As String
    Dim xExcelApp As Excel.Application
    Dim xWb As Excel.Workbook
    Dim xWs As Excel.Worksheet

    'declare xls file
    xExcelFile = "C:\Temp\Temp.xlsm"
    'open the xls file
    Set xExcelApp = CreateObject("Excel.Application")
    Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
    Set xWs = xWb.Sheets(1)

    ' get the email adresses. here i get into trouble
    Dim rng As Variant
    Set rng = xWs.Range("A2:A3")

    Dim Cell As Range
    For Each Cell In rng
        Debug.Print Cell.Value
    Next

End Sub