macro to download subject, email address from outlook

[revelares]

Hi, I need help with the macro be used under outlook - and to get output in excel. This macro was working fine for almost a year, but starting from few days - I cannot run it - as I got a message: User defined type not defined. Do you know what can be the issue? Maybe someone modified it incorrectly? To be honest I do not have idea what could changed....

Thanks in advance,

Below you will find macro that I use:

Dim allFolders As New Collection


Sub Main()


UserForm1.Show


End Sub


Sub Zapisz_do_Excela(d1 As String, d2 As String, ItemsSelection As Boolean)


Unload UserForm1


Dim ns As NameSpace


Set ns = GetNamespace("MAPI")


Dim inbox As Folder


Set inbox = ns.Folders("private").Folders("Inbox")


allFolders.Add inbox


Dim xApp As New Excel.Application


xApp.Visible = True


Dim wb As Excel.Workbook, sh As Excel.Worksheet, rg As Range


Set wb = xApp.Workbooks.Add


Set sh = xApp.Sheets("Sheet1")


sh.Range("A1:E1") = Array("Nr", "question", "Data", "email", "Subject")


Set rg = sh.Range("A2:E2")


Dim msg As Outlook.MailItem


If ItemsSelection Then


For Each msg In Application.ActiveExplorer.Selection


If msg.Class = olMail Then EnumerateMatches msg, rg


Next msg


Else


GetFolder inbox


For Each subFolder In allFolders


For Each msg In subFolder.Items


If msg.Class = olMail And DateValue(msg.ReceivedTime) >= CDate(d1) And DateValue(msg.ReceivedTime) <= CDate(d2) Then


EnumerateMatches msg, rg


End If


Next msg


Next subFolder


End If


sh.Columns("A:D").AutoFit


sh.Columns("B").NumberFormat = "0"


End Sub


Sub GetFolder(folderToCheck As Folder)


Dim currentfolders As New Collection


Dim f As Folder, g As Folder


For Each f In folderToCheck.Folders


Debug.Print f.Name


allFolders.Add f


currentfolders.Add f


Next f


For Each g In currentfolders


GetFolder g


Next g


End Sub


Sub EnumerateMatches(msg As Outlook.MailItem, rg As Range)


Dim r As New RegExp


r.Global = True


r.Pattern = "(\d{7,12})"


Dim Match As Match


For Each Match In r.Execute(msg.Subject)


rg = Array(msg.Parent.FolderPath, Match.SubMatches(0), DateValue(msg.ReceivedTime), msg.SenderEmailAddress, "'" & msg.Subject)


Set rg = rg.Offset(1)


Next Match


End Sub

 

[Worf]

Hi

What line throws the error? Check if you have this reference:

Outlook > VBE > Tools > References > Microsoft Excel Object Library.