Hello,
I've been trying to pull a list from excel 2016 and use it as the search inputs in Outlook 2016. after the message is found (or not), the code should download any attachments.
So far, i've got the code to work from excel, but it is rather slow. I am trying to run it from Outlook, but can't seem to grab the range from excel. the specific line
Set SourceRange = sourcesh.Selection.CurrentRegion
that should call the range throws a run-time error 438 "object doesn't support this property or method". I have included the Excel 16 reference.
here is my code:
Sub import_from_excel()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim sourceWB As Workbook
Dim sourceWS As Worksheet
Dim olNs As Outlook.NameSpace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim arr As Variant
Dim SourceRange As Range
Dim R As Long
Dim sArr As String
strfile = "T:\outlookTest\Book1.xlsm"
Set sourceWB = Workbooks.Open(strfile, , False, , , , , , , True)
Set sourcesh = sourceWB.ActiveSheet
Set SourceRange = sourcesh.Selection.CurrentRegion
arr = SourceRange.Value
For R = LBound(arr, 1) To UBound(arr, 1)
sArr = arr(R, 1)
MsgBox sArr
Set olNs = olkApp.GetNamespace("MAPI")
Set Fldr = olNs.Folders("Archive")
Set Fldr = Fldr.Folders("Inbox")
Set myTasks = Fldr.Items
Set olMail = myTasks.Find("[Subject] like '%" & sArr & "%'")
If Not (olMail Is Nothing) Then
For Each objmessage In olMail
intcount = objmessage.Attachments.Count
If intcount > 0 Then
For i = 1 To intcount
objmessage.Attachments.Item(i).SaveAsFile "T:\outlookTest\" & objmessage.Attachments.Item(i).FileName
Next
End If
Next
Else: MsgBox "Nothing Found"
End If
Next R
End Sub
Any ideas? many thanks