Const olFolderContacts = 10 Set Outlook = CreateObject("Outlook.Application") Set Fs = CreateObject("Scripting.FileSystemObject") Set ts = Fs.CreateTextFile("Address.lst") For Each oItem In Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items If oItem.Email1Address<>"" Then ts.WriteLine oItem.Email1Address & vbTab & oItem.FullName End If If oItem.Email2Address<>"" Then ts