PDA

View Full Version : Help with an Export Macro to Excel



RobWulf
05-02-2013, 02:27 PM
Okay, I got this code to work, but I want to open an excel file then write the data to the fields.


Sub Extract()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
Set xlobj = CreateObject("excel.application.14")
'Set book = GetObject("C:\Users\h108718\Desktop\MailBoxLog - Copy.xlsm")
xlobj.Visible = True
xlobj.workbooks.Add
'Set Heading
'xlobj.Range("e" & 1).Value = "Body"
'Not saving the body at this time.
xlobj.Range("a" & 1).Value = "Recieved Date"
xlobj.Range("b" & 1).Value = "Sender"
'xlobj.Range("D" & 1).Value = "Recipiant"
'decided against saving the Recipiant, just creates a lot of clutter when others are also listed.
xlobj.Range("D" & 1).Value = "Subject"
'xlobj.Range("F" & 1).Value = "Categories"
For i = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(i)
msgtext = myitem.Body

'xlobj.Range("E" & i + 1).Value = msgtext
xlobj.Range("A" & i + 1).Value = myitem.ReceivedTime
xlobj.Range("B" & i + 1).Value = myitem.Sender
xlobj.Range("D" & i + 1).Value = myitem.Subject
'xlobj.Range("F" & i + 1).Value = myitem.Categories
'xlobj.Range("D" & i + 1).Value = myitem.To
Next
End Sub



It works great aside from the fact it creates a new workbook every time, I just want to be able to tell it where the file is located and have it write the above data to those columns.

Thanks for looking.

snb
05-02-2013, 02:46 PM
If you use this code from within Outlook:



Sub M_snb()
j=1
with getobject("G:\OF\example.xlsx")
.sheets(1).cells(1,1).resize(,3)=split("Date Recieved_sender_subject","_")
for each it in Outlook.GetNamespace("mapi").ActiveExplorer.CurrentFolder.items
j=j+1
.sheets(1).cells(j,1).resize(,3)=array(.ReceivedTime,
.Sender,.Subject)
Next
end with
end sub

RobWulf
05-02-2013, 03:00 PM
If you use this code from within Outlook:



Sub M_snb()
j=1
with getobject("G:\OF\example.xlsx")
.sheets(1).cells(1,1).resize(,3)=split("Date Recieved_sender_subject","_")
for each it in Outlook.GetNamespace("mapi").ActiveExplorer.CurrentFolder.items
j=j+1
.sheets(1).cells(j,1).resize(,3)=array(.ReceivedTime,
.Sender,.Subject)
Next
end with
end sub


Not sure what I could be doing wrong with this code, but it keeps giving me an error at the line



for each it in Outlook.GetNamespace("mapi").ActiveExplorer.CurrentFolder.items



saying the object is not defined

snb
05-02-2013, 03:17 PM
Probably:


for each it In Outlook.ActiveExplorer.CurrentFolder.items