Macro for recording the attachment name into Excel from Outlook

[prazad82]

Can anyone help me with a macro that can get the details of the following email fields from inbox into an excel sheet?

Subject
Sender Email
Date
Time
Attachment Name
Location where the attachment is saved

Thanks in advance

[westconn1]

you can get the attachment name from the email, bu not the location where it is saved, you might have to try searchtreeforfile API, to search the hard drive for the file, though if the attachment name could be duplicated it will have difficulty determining the correct file without comparison

[prazad82]

you can get the attachment name from the email, bu not the location where it is saved, you might have to try searchtreeforfile API, to search the hard drive for the file, though if the attachment name could be duplicated it will have difficulty determining the correct file without comparison

Thank you for your reply. I am glad to hear that there is a way to get the attachment name from the email!!! I have a macro that capture the other details, but not the attachment file name (i am not sure where to place that). Could you help me with that?

Please let me know how do I sent the code I have.

[westconn1]

see if this works for you

If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
col = 4
For Each a In olkMsg.attatchments
excWks.Cells(inrow, col).Value = a.Filename
col = col + 1
Next
intRow = intRow + 1
End If

[prazad82]

It throws an error. I have the code below. Please let me know if this is correct.

For Each olkMsg In Application.ActiveExplorer.CurrentFolder.Items
'Only export messages, not receipts or appointment requests, etc.
If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
col = 4
For Each a In olkMsg.attatchments
excWks.Cells(inrow, col).Value = a.FileName
col = col + 1
Next
intRow = intRow + 1
End If
Next
Set olkMsg = Nothing
excWkb.SaveAs strFilename
excWkb.Close
End If
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
MsgBox "Process complete. A total of " & intRow - 2 & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel"
End Sub

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
On Error Resume Next
Select Case intOutlookVersion
Case Is < 14
If Item.SenderEmailType = "EX" Then
GetSMTPAddress = SMTP2007(Item)
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
Case Else
Set olkSnd = Item.Sender
If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
Set olkEnt = olkSnd.GetExchangeUser
GetSMTPAddress = olkEnt.PrimarySmtpAddress
Else
GetSMTPAddress = Item.SenderEmailAddress
End If

[prazad82]

Hey, I was able to get the macro work, finally. Thank you for your help!

One question though: How do I have the date and time in two different columns?

[westconn1]

format the received time appropriately twice

cells(introw, 3) = format(msg.ReceivedTime,"dd/mm/yyyy")
cells(introw, 4) = format(msg.ReceivedTime,"hh:nn:ss")

[prazad82]

Hey, How do I customize this code to suit MS office 2003?

[westconn1]

which part does not work in 2003?