Transfer Outlook Email to Excel and its Attachment to Drive C

Hi,

I am new to VBA and I am trying to look for a solution in solving below codes. I would like to transfer the email to excel when I enter a specified date. If it has attachment, it will save on Drive C/Email Attach/. I have search it in google however there are bugs which I can't understand. I am encountering an error that says, " Run-time error 424 Object Required" under the line "Range("Email_Subject").offset(1,0).Value = Outlookmail.Subject". I would also be very grateful if you could also add the attachment code to it. Please if anyone there who could help, please help me. I would be very much grateful for that. You may revised my work if you think it is not the correct one.

Code:

---

Dim olApp as Outlook.Application
Dim olNS as Outlook.Namespace
Dim olFldr as Outlook.MAPIFolder
Dim OlItms as Outlook.Items
Dim olMail as Variant


Dim 1 as Integer


Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace ("MAPI")
Set OlFldr = olNS.Pickfolder
if olFldr = "Nothing" then Exit sub
  Set olItms = olFldr.Items


i = 1


if olItms.ReceivedTime >= Range("B4").value then


    Range("Email_Subject").offset(1,0).Value = Outlookmail.Subject
    Range("Email_Date").offset(1,0).Value = Outlookmail.ReceivedTime
    Range("Email_Sender").offset(1,0).Value = Outlookmail.SenderName
    Range ("Email_Body").offset(1,0).Value = Outlookmail.body
    i = 1 + 1
  else
endif


Range("A:D").EntireColumn.Autofit


Set Folder = Nothing
Set olFldr = Nothing
Set olApp = Nothing


End Sub

---

Thanks

As you are new to VBA, may I suggest adding Option Explicit to the module as that will force you to declare your variables and then you won't so readily get the variable names mixed up - or reinvented as in your example.

The outlook code would be better as shown below - I'll leave the Excel stuff to you given that we don't know what is on the worksheet. I would also suggest checking what you have in B4 with regard to the mail received time as they need to match. You may also have a problem reading the mail body into a cell. May I suggest you test with a folder that contains few items.

Code:

---

Sub GetMailContent()

Dim olApp As Object
Dim olNS As Object
Dim olFldr As Object
Dim olItems As Object
Dim olMail As Object


Dim i As Integer


    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0




    Set olNS = olApp.GetNamespace("MAPI")
    Set olFldr = olNS.Pickfolder
    If olFldr = "Nothing" Then Exit Sub
    Set olItems = olFldr.Items




    For i = 1 To olItems.Count
        Set olMail = olItems(i)
        If TypeName(olMail) = "MailItem" Then
Debug.Print olMail.ReceivedTime


            If olMail.ReceivedTime >= Range("B4").value Then
                Range("Email_Subject").Offset(1, 0).value = olMail.Subject
                Range("Email_Date").Offset(1, 0).value = olMail.ReceivedTime
                Range("Email_Sender").Offset(1, 0).value = olMail.SenderName
                'Range("Email_Body").Offset(1, 0).value = olMail.body
            End If
        End If
    Next i


    Range("A:D").EntireColumn.AutoFit


    Set olFldr = Nothing
    Set olApp = Nothing
    Set olMail = Nothing
    Set olNS = Nothing
    Set olItems = Nothing
End Sub

---