简体   繁体   中英

How to assign a list of strings from an Excel range to an Outlook VBA variable?

How do I assign a list of stings from an excel range to an outlook vba variable?

I have the following running in Outlook. I Intend to pull a list of email addresses (strings) from an Excel sheet, for sender comparison.

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

which returns

A2
A3
A4
A10

A1

with my "email addresses" in test1.xlsx as follows:
在此处输入图像描述

Note that I specified rng to be the two cells "A2:A3", yet, cells A1 until A10 are contained. rng(100) returns the empty string.

I would like a list object with indices 1 and 2, containing "A2" and "A3". In a second step, I need my list to contain cell A2 until the last nonempty cell of column A.

EDIT
The above is the minimal example. The context is that I want to check incoming email Items for their sender address and move them to according folders.

The key problem is that the list of email addresses I obtain seems to be infinitely long to the for each loop:

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

where the array rng2 is the list with emails, made below:

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

At the very end I need a workspace variable containing a (finite) list that I can a) iterate via for each and b) index like list(1) to list(N)

[solution]

My "hack" is to ReDim the variant to a known length, and assign each element:

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

Everything runs smoothly now.
Still I am flabbergasted by that variant behavior or I haven't understood it.

Is this what you are trying to do?

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM