hi
Option Explicit
Sub ExportToExcel()
On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
strSheet = "OutlookItems.xls"
strPath = "C:\Examples\"
strSheet = strPath & strSheet
Debug.Print strSheet 'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder 'Handle potential errors with Select Folder
dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
End If 'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True 'Copy field items in mail folder.
For Each itm In fld.Items
intColumnCounter = 1
Set msg = itm
intRowCounter = intRowCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.To
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderEmailAddress
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Subject
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SentOn
intColumnCounter = intColumnCounter + 1
'Set rng = wks.Cells(intRowCounter, intColumnCounter)
'rng.Value = msg.ReceivedTime
'Set rng = wks.Cells(intRowCounter, intColumnCounter)
'
'rng.Value = msg.Body
'
'intColumnCounter = intColumnCounter + 1
Next itm
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, _
"Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, _
"Error"
End If
'ErrHandler:
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub
Try this
Copy Above Code As it is and goto outlook --> Press Alt+F11 -->insert
New module and Past it
and goto tools on Vb editor ---> goto Reference ---> and mark on
microsoftexcel 12.0Object library
Save that and restart the ms outlook and press Alt+f8 -->run that
before that
create a new folder in c: drive
on that folder keep excel file inthe nae of "Examples"
this path was reflected on below path
allready this is part of above code this is only for ur reference
purpose
"
Dim itm As Object
strSheet = "OutlookItems.xls"
strPath = "C:\Examples\"
"
Regards
On Feb 16, 8:24 pm, "B.N.Chethan Kumar" <chetankumar1...@gmail.com>
wrote:
> Dear friends,
>
> Need a help. I need to import email information into excel need following
> information from Outlook express.
>
> email received: -
>
> Sender Name or Email ID
> Sender time:
> Subject:
>
> Email responded:
>
> Responded name or email id
> Responded time
> Subject:
>
> --
> B.N Chetan kumar
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
