Transfer Outlook Email to Excel and its Attachment to Drive C

[vistarbistik]

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.

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

[gmayor]

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.

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