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 linethat 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.Set SourceRange = sourcesh.Selection.CurrentRegion
here is my code:
Any ideas? many thanksSub 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




Reply With Quote