• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 341
  • Last Modified:

Export Outlook 2000 folder to Excel file with Access VBA: how to include more than 3 fields.

I have developed a code that exports an Outlook subfolder, with 4 fields/properties for each message.
Unfortunately it creates the first 10 rows in the .xls spreadsheet and then it hangs on "myXl.Activesheet.Cells(j + 1, 3) = olkItem.SenderName" line, saying that properties ".SenderName" and ".SenderEmailAddress" are not supported.
Can you help please? Thanx.
Public Function EsportaRicevuteOutlook()
 
    Dim olkApp As Object, olkNS As Object, olkFolder As Object, myXl As Object
    Dim olkItems As Object, olkItem As Object
    Dim i As Integer, j As Integer
    Dim olkProp As Outlook.ItemProperty
    Set olkApp = CreateObject("Outlook.application")
    Set myXl = CreateObject("Excel.application")
    Set olkNS = olkApp.GetNamespace("MAPI")
    Set olkFolder = olkNS.GetDefaultFolder(6).Folders("Ricevute messaggi")
    
    Set olkItems = olkFolder.Items
    i = olkItems.Count
    myXl.Visible = True
    myXl.Workbooks.Add
    myXl.Sheets("Foglio2").Select
    myXl.Activesheet.Delete
    myXl.Sheets("Foglio3").Select
    myXl.Activesheet.Delete
    myXl.Sheets("Foglio1").Select
    myXl.Sheets("Foglio1").Name = "Ricevute"
 
    myXl.Activesheet.Cells.Value = "Oggetto"
    myXl.Activesheet.Cells.Value = "Testo"
    myXl.Activesheet.Cells.Value = "Mittente"
    myXl.Activesheet.Cells.Value = "Email"
    
    j = 0
    For Each olkItem In olkItems
        myXl.Activesheet.Cells(j + 1, 1) = olkItem.Subject
        myXl.Activesheet.Cells(j + 1, 2) = olkItem.Body
        myXl.Activesheet.Cells(j + 1, 3) = olkItem.SenderName
        myXl.Activesheet.Cells(j + 1, 4) = olkItem.SenderEmailAddress
        j = j + 1
    Next olkItem
    
    myXl.Activesheet.Columns("A:A").EntireColumn.AutoFit
    myXl.Activesheet.Columns("B:B").EntireColumn.AutoFit
    myXl.Activesheet.Columns("C:C").EntireColumn.AutoFit
    myXl.Activesheet.Columns("D:D").EntireColumn.AutoFit
    
    myXl.ActiveWorkbook.SaveAs "C:\Ricevute.xls"
    myXl.ActiveWorkbook.Close
    myXl.Quit
 
End Function

Open in new window

0
Sar1973
Asked:
Sar1973
  • 7
  • 6
1 Solution
 
NorieVBA ExpertCommented:
What version of Outlook is the code using?

Those properties were new to 2003.
0
 
Sar1973Author Commented:
I am using Access 2000 and Outlook 2003. Do you think that this is the cause of my trouble?
Notice that the code hangs after 10 lines, which I get correctly in my worksheet.
0
 
NorieVBA ExpertCommented:
Does all the code work without those 2 lines?

What's version of Microsoft Outlook... is listed when you goto Tools>References...?

Also what references are checked?

Is this code being used on more than 1 computer/setup? If it is does it fail on some and not others?

Where is the code being run from?
Public Function EsportaRicevuteOutlook()
 
Dim olkApp As Object
Dim olkNS As Object
Dim olkFolder As Object
Dim olkItems As Object
Dim olkItem As Object
Dim olkProp As Outlook.ItemProperty
 
Dim myXl As Object
Dim myWB As Object
Dim myWS As Object
Dim I As Long
Dim J As Long
    
    
    Set olkApp = CreateObject("Outlook.application")
    Set myXl = CreateObject("Excel.application")
    Set olkNS = olkApp.GetNamespace("MAPI")
    Set olkFolder = olkNS.GetDefaultFolder(6).Folders("Ricevute messaggi")
    
    Set olkItems = olkFolder.Items
    
    I = olkItems.Count
    
    myXl.Visible = True
    
    Set myWB = myXl.Workbooks.Add(-4167)
    
    Set myWS = myWB.Worksheets(1)
    
    myWS.Name = "Ricevute"
    
    ' this is strange - why are you filling all the cells in the worksheet
    ' with one value, then repeating for another value and so on?
 
    myWS.Cells.Value = "Oggetto"
    myWS.Cells.Value = "Testo"
    myWS.Cells.Value = "Mittente"
    myWS.Cells.Value = "Email"
    
    For Each olkItem In olkItems
        myWS.Cells(J + 1, 1) = olkItem.Subject
        myWS.Cells(J + 1, 2) = olkItem.Body
        myWS.Cells(J + 1, 3) = olkItem.SenderName
        myWS.Cells(J + 1, 4) = olkItem.SenderEmailAddress
        J = J + 1
    Next olkItem
    
    myWS.Range("A:D").EntireColumn.AutoFit
    
    myXl.ActiveWorkbook.SaveAs "C:\Ricevute.xls"
    myXl.ActiveWorkbook.Close
    
    myXl.Quit
 
End Function

Open in new window

0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
Sar1973Author Commented:
1. "Does all the code work without those 2 lines?" Sorry, there was a mistake: the code below writes correctly the header line
2. "What's version of Microsoft Outlook... is listed when you goto Tools>References...?" Outlook 2003 but, as I told you, Access 2000
3. "Also what references are checked?" What do you mean by checked references?
4. "Is this code being used on more than 1 computer/setup? If it is does it fail on some and not others?" No, no.
5. "Where is the code being run from?" An Access 2000 form, which launches the function with a button. With the new code below it hangs exactly on row 10 (9th item), column 3 (sender name) saying that "variable With block not set", as if the code would need a With method.
Public Function EsportaRicevuteOutlook()
    
    Dim olkApp As Object, olkNS As Object, olkFolder As Object, myXl As Object
    Dim olkItems As Object, olkItem As Object
    Dim i As Integer, j As Integer
    Dim olkProp As Outlook.ItemProperty
    Set olkApp = CreateObject("Outlook.application")
    Set myXl = CreateObject("Excel.application")
    Set olkNS = olkApp.GetNamespace("MAPI")
    Set olkFolder = olkNS.GetDefaultFolder(6).Folders("Ricevute messaggi")
    
    Set olkItems = olkFolder.Items
    i = olkItems.Count
    myXl.Visible = True
    myXl.Workbooks.Add
    myXl.Sheets("Foglio2").Select
    myXl.Activesheet.Delete
    myXl.Sheets("Foglio3").Select
    myXl.Activesheet.Delete
    myXl.Sheets("Foglio1").Select
    myXl.Sheets("Foglio1").Name = "Ricevute"
    
    myXl.Activesheet.Cells(1, 1).Value = "Oggetto"
    myXl.Activesheet.Cells(1, 2).Value = "Testo"
    myXl.Activesheet.Cells(1, 3).Value = "Mittente"
    myXl.Activesheet.Cells(1, 4).Value = "Email"
    
    j = 2
    For Each olkItem In olkItems
        myXl.Activesheet.Cells(j, 1) = olkItem.Subject
        myXl.Activesheet.Cells(j, 2) = olkItem.Body
        myXl.Activesheet.Cells(j, 3) = olkItem.SenderName
        myXl.Activesheet.Cells(j, 4) = olkItem.SenderEmailAddress
        j = j + 1
    Next olkItem
    
    myXl.Activesheet.Columns("A:A").EntireColumn.AutoFit
    myXl.Activesheet.Columns("B:B").EntireColumn.AutoFit
    myXl.Activesheet.Columns("C:C").EntireColumn.AutoFit
    myXl.Activesheet.Columns("D:D").EntireColumn.AutoFit
    
    myXl.ActiveWorkbook.SaveAs "C:\Ricevute MKT.xls"
    myXl.ActiveWorkbook.Close
    myXl.Quit
 
End Function

Open in new window

0
 
NorieVBA ExpertCommented:
1 I was really asking if the code worked without the 2 lines of code that appear to be causing the problem

2 The important thing is the version of Outlook, Access doesn't actually have any relevance here. The code could have been written in Excel VBA, Outlook VBA etc.

3 References that are checked when you goto Tools>References..., ie those with a tick next to them.

5 What do you mean exactly? Do you mean the code works for the first 9 Outlook items but fails on the 10th?

If that's the case the problem is most likely because that item doesn't have SenderName or SenderEmailAddress.

By the way do you actually have a reference for Outlook checked?

The reason I ask is because of this.

Dim olkApp As Object, olkNS As Object, olkFolder As Object, myXl As Object
Dim olkItems As Object, olkItem As Object
Dim olkProp As Outlook.ItemProperty

Why are you declaring most of these as 'Object' but olkProp as 'ItemProperty'?
0
 
Sar1973Author Commented:
I don't know, really: if I must say I have took codes around and arranged them together.
That's also why I have posted the question: to have a proper code.
I confirm my previous answers  and tell you:
3. I haven't any check on "mail format": the messages are sent in HTML, Word is not the predefined editor
5. exactly
0
 
NorieVBA ExpertCommented:
3 I have no idea what you mean - I never mentioned 'mail format' anywhere. I'm referring to the references in the VBE when you goto Tools>References...

5 This means that the problem most likely lies with the items not the code. I'm afraid I can't test this out as I don't use Outlook any more.

    What happens when you either omit or comment out the 2 lines causing the problem?
0
 
Sar1973Author Commented:
If I set only 2 properties to be exported, it works. That's the reason of my question.
0
 
NorieVBA ExpertCommented:
Then the problem probably lies with the data, ie the Outlook items, not the code.

Is there anything 'different' about the item(s) the code fails on?
0
 
Sar1973Author Commented:
No, that's also why I posted the question: the items are all the same, without empty fields or other.
I have noticed instead that the code extracts first items which are in the middle of the folder, sorted by date.
0
 
NorieVBA ExpertCommented:
Sorry I can't make any further suggestions.

You insist there is no problems with the items, are you 100% sure about that?

How are you actually checking that?
0
 
Sar1973Author Commented:
I have scrolled the whole folder and I have also took a look to the .xls file exported directly from Outlook: each item has a precise value/content in every field.
0
 
Sar1973Author Commented:
-
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now