#1
|
|||
|
|||
Export a list of inbox emails into excel
Hi, is there any way to export a list of inbox email into excel in the way that one row represents one email and columns are categories (from,date,subject....)? I can export emails but not in this format. Thanks!
|
#2
|
||||
|
||||
Maybe something like
Code:
Sub CopyInboxMsgDataToExcel() Dim xlApp As Object Dim xlWb As Object Dim xlSheet As Object Dim olItems As Outlook.Items Dim olItem As Outlook.MailItem Dim sFrom As String Dim sDate As String Dim sSubject As String Dim rCount As Long Dim bXStarted As Boolean Dim FSO As Object Dim lCount As Long Const strPath As String = "C:\Path\Inbox.xlsx" 'the path of the workbook If Application.ActiveExplorer.Selection.Count = 0 Then MsgBox "No Items selected!", vbCritical, "Error" Exit Sub End If On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err <> 0 Then Application.StatusBar = "Please wait while Excel source is opened ... " Set xlApp = CreateObject("Excel.Application") bXStarted = True End If On Error GoTo 0 Set FSO = CreateObject("Scripting.FileSystemObject") If Not FSO.FileExists(strPath) Then Set xlWb = xlApp.Workbooks.Add Set xlSheet = xlWb.Sheets("Sheet1") With xlSheet .Range("A1").Value = "From" .Range("B1").Value = "Date" .Range("C1").Value = "CSubject" End With xlWb.SaveAs strPath Else 'Open the workbook to input the data Set xlWb = xlApp.Workbooks.Open(strPath) Set xlSheet = xlWb.Sheets("Sheet1") End If xlApp.Visible = True Set olItems = Session.GetDefaultFolder(olFolderInbox).Items For lCount = olItems.Count To 1 Step -1 Set olItem = olItems(lCount) If TypeName(olItem) <> "Nothing" Then On Error GoTo Skip sFrom = olItem.Sender sDate = CStr(olItem.SentOn) sSubject = olItem.Subject 'Find the next empty line of the worksheet rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row rCount = rCount + 1 xlSheet.Range("A" & rCount) = sFrom xlSheet.Range("B" & rCount) = sDate xlSheet.Range("C" & rCount) = sSubject xlWb.Save DoEvents End If Skip: On Error Resume Next Next lCount xlWb.Close SaveChanges:=True If bXStarted Then xlApp.Quit End If Set xlApp = Nothing Set xlWb = Nothing Set xlSheet = Nothing Set olItem = Nothing Set olItems = Nothing lbl_Exit: Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Emails not being placed in inbox | Stacifr | Outlook | 0 | 08-21-2018 01:36 PM |
Finding a folder in the Inbox list from a proprietary list | kovenna | Outlook | 0 | 05-09-2017 06:18 AM |
How to print a "list only" of ALL the emails in my Inbox and Sent Box in Outlook | Kotichka | Outlook | 2 | 02-12-2016 01:39 AM |
Inbox emails are gone | D. L. Painter | Outlook | 2 | 02-24-2013 07:04 AM |
How to export contact list to Excel | ksimmonds | Outlook | 2 | 12-07-2011 09:33 PM |