Export Custom Forms in Public Folder to Excel

[Cass]

I have created a custom form in the CUSTOMER folder in out Public
Folders. The form was created on a contacts form. I am trying to
export the fields on this form to an excel file. So that every contact
that is saved in the folder will be exported to that excel file in the
appropriate column. I have the following code so far:


Function item_click()
Dim objXL
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add("C:\EZReader\test.xls")
objXL.Cells(A, 1).Value = Item.Userproperties.find("utility")
objXL.Cells(A, 2).Value = Item.Userproperties.find("CityState")
objXL.Cells(A, 3).Value = Item.Userproperties.find("MainContact")
objXL.Application.Save = "C:\EZReader\test.xls"
objXL.Application.Quit
Set objXL=Nothing
Set MyBook=Nothing
End Function


I have 2 problems with this code:

1. when I save a new contact, nothing happens
2. the code looks as if it will only update each cell (ex. (A,1)) for
each contact and not add additional rows

Please help.

 

[Cass]

How do I change the following code to include user properties?


Option Explicit

Sub Import_Contacts()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olColItems As Outlook.Items
Dim olItem As Object
Dim strDummy As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim i As Long

Application.ScreenUpdating = False

'Instantiate the MS Outlook objects.
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.PickFolder

If olFolder Is Nothing Then
GoTo ExitSub
ElseIf olFolder.DefaultItemType <> olContactItem Then
MsgBox "The selected folder does not contain contacts.",
vbOKOnly
GoTo ExitSub
ElseIf olFolder.Items.Count = 0 Then
MsgBox "No contacts to import.", vbOKOnly
GoTo ExitSub
End If

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)

'Prepare the targeting worksheet.
With wsSheet
.Range("A1").CurrentRegion.Clear
.Cells(1, 1).Value = "Company / Private person"
.Cells(1, 2).Value = "Street address"
.Cells(1, 3).Value = "Postal code"
.Cells(1, 4).Value = "City"
.Cells(1, 5).Value = "Contact person"
.Cells(1, 6).Value = "E-mail"
With Range("A1:F1")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With
End With

Set olColItems = olFolder.Items

'Iterate the collection of contact items.
i = 2
For Each olItem In olColItems
If TypeName(olItem) = "ContactItem" Then
With olItem
If InStr(olItem.CompanyName, strDummy) > 0 Then
Cells(i, 1).Value = .CompanyName
Cells(i, 2).Value = .BusinessAddressStreet
Cells(i, 3).Value = .BusinessAddressPostalCode
Cells(i, 4).Value = .BusinessAddressCity
Cells(i, 5).Value = .FullName
Cells(i, 6).Value = .Email1Address
Else
Cells(i, 1).Value = .FullName
Cells(i, 2).Value = .HomeAddressStreet
Cells(i, 3).Value = .HomeAddressPostalCode
Cells(i, 4).Value = .HomeAddressCity
Cells(i, 5).Value = .FullName
Cells(i, 6).Value = .Email1Address
End If
End With
i = i + 1
End If
Next olItem


With wsSheet
'Sort the list.
.Range("A2", Cells(2, 6).End(xlDown)).Sort Key1:=Range("A2"), _
Order1:=xlAscending
.Range("A:F").EntireColumn.AutoFit
End With

Application.ScreenUpdating = True

MsgBox "The list has successfully been updated!", vbInformation

ExitSub:
Set olItem = Nothing
Set olColItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End Sub

 

[Sue Mosher [MVP-Outlook]]

1) The intrinsic Item object does not support a Click event. If you want code to run when an item is saved, it should go in the Item_Write event handler.

2) You would need to use provide a different value for A, the variable representing the row, for each row you want to fill.

You may also want to consider what you want Outlook to do when you save a contact for the 2nd, 3rd, etc. time.

 

[Sue Mosher [MVP-Outlook]]

As in your other post in this thread:

objXL.Cells(A, 1).Value = Item.Userproperties.find("utility")

or simply Item.Userproperties("utility")

See http://outlookcode.com/article.aspx?ID=38

 

[Cass]

I got it to work by simple changing the code to :



Option Explicit

Sub Import_Contacts()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olColItems As Outlook.Items
Dim olItem As Object
Dim strDummy As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim i As Long

Application.ScreenUpdating = False

'Instantiate the MS Outlook objects.
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.PickFolder

If olFolder Is Nothing Then
GoTo ExitSub
ElseIf olFolder.DefaultItemType <> olContactItem Then
MsgBox "The selected folder does not contain contacts.",
vbOKOnly
GoTo ExitSub
ElseIf olFolder.Items.Count = 0 Then
MsgBox "No contacts to import.", vbOKOnly
GoTo ExitSub
End If

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)

'Prepare the targeting worksheet.
With wsSheet
.Range("A1").CurrentRegion.Clear
.Cells(1, 1).Value = "Utility"
.Cells(1, 2).Value = "City, State"
.Cells(1, 3).Value = "Main Contact"
.Cells(1, 4).Value = "City"
.Cells(1, 5).Value = "Contact person"
.Cells(1, 6).Value = "E-mail"
With Range("A1:F1")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With
End With

Set olColItems = olFolder.Items

'Iterate the collection of contact items.
i = 2
For Each olItem In olColItems
If TypeName(olItem) = "ContactItem" Then
With olItem
If InStr(olItem.FileAs, strDummy) > 0 Then
Cells(i, 1).Value = .UserProperties("Utility")
Cells(i, 2).Value = .UserProperties("CityState")
Cells(i, 3).Value = .UserProperties("MainContact")
Cells(i, 4).Value = .BusinessAddressCity
Cells(i, 5).Value = .FullName
Cells(i, 6).Value = .Email1Address

Else
Cells(i, 1).Value = .FullName
Cells(i, 2).Value = .HomeAddressStreet
Cells(i, 3).Value = .HomeAddressPostalCode
Cells(i, 4).Value = .HomeAddressCity
Cells(i, 5).Value = .FullName
Cells(i, 6).Value = .Email1Address
End If
End With
i = i + 1
End If


Next olItem


With wsSheet
'Sort the list.
.Range("A2", Cells(2, 6).End(xlDown)).Sort Key1:=Range("A2"), _
Order1:=xlAscending
.Range("A:F").EntireColumn.AutoFit
End With

Application.ScreenUpdating = True

MsgBox "The list has successfully been updated!", vbInformation

ExitSub:
Set olItem = Nothing
Set olColItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End Sub





However now I get the following message when I run the code:
"a program is trying to access e-mail addresses you have stored in
outlook. do you want to allow this"

And I have to click yes for every single contact in my address book.
Can I stop this error message from appearing?

 

[Sue Mosher [MVP-Outlook]]

See http://www.outlookcode.com/article.aspx?ID=52 for your options with regard to the "object model guard" security in Outlook 2000 SP2 and later versions. Rewriting the code as an Outlook VBA routine, upgrading to Outlook 2007, and rewriting to use Redemption would all be viable solutions.

 

[Cass]

Seehttp://www.outlookcode.com/article.aspx?ID=52for your options with regard to the "object model guard" security in Outlook 2000 SP2 and later versions. Rewriting the code as an Outlook VBA routine, upgrading to Outlook 2007, and rewriting to use Redemption would all be viable solutions.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54






















- Show quoted text -

so can you tell me what these fields are named in outlook because when
I add them to the code i get a debug error

It's the Notes field and the Categories field. The following doesn't
work.

Cells(i, 28).Value = .Notes
Cells(i, 29).Value = .Categories

 

[Cass]

so can you tell me what these fields are named in outlook because when
I add them to the code i get a debug error

It's the Notes field and the Categories field. The following doesn't
work.

Cells(i, 28).Value = .Notes
Cells(i, 29).Value = .Categories- Hide quoted text -

- Show quoted text -

Oh also i'm getting the debug error on the Contacts field too. These
are all the default outlook fields but they're not being recognized in
the code. I get this debug error "Run-time error '438': Object doesn't
support this property or method.

 

[Cass]

so can you tell me what these fields are named in outlook because
when
I add them to the code i get a debug error

It's the Notes field and the Categories field. The following doesn't
work.


Cells(i, 28).Value = .Notes
Cells(i, 29).Value = .Categories

Oh also i'm getting the debug error on the Contacts field too. These
are all the default outlook fields but they're not being recognized in
the code. I get this debug error "Run-time error '438': Object
doesn't
support this property or method.- Hide quoted text -


Also all my dates fields are being exported to Excel with 949998 and
when there is a date in, for example 9/30/2007, in excel it displays
as 39355.3333333333

 

[Cass]

Seehttp://www.outlookcode.com/article.aspx?ID=52for your options with regard to the "object model guard" security in Outlook 2000 SP2 and later versions. Rewriting the code as an Outlook VBA routine, upgrading to Outlook 2007, and rewriting to use Redemption would all be viable solutions.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54






















- Show quoted text -

so can you tell me what these fields are named in outlook because
when
I add them to the code i get a debug error

It's the Notes field and the Categories field. The following doesn't
work.


Cells(i, 28).Value = .Notes
Cells(i, 29).Value = .Categories


Oh also i'm getting the debug error on the Contacts field too. These
are all the default outlook fields but they're not being recognized
in
the code. I get this debug error "Run-time error '438': Object
doesn't
support this property or method.


Also all my dates fields with no dates, which say "None" by default in
the outlook form are being
imported into excel as 1/1/4501. How do I get excel to just leave it
blank?

 

[Sue Mosher [MVP-Outlook]]

When in doubt about property names, use the object browser -- F2 in VBA.

"Notes" = Body
Categories -- that's the correct name.
Contacts = the Links collection, not a text property

Also all my dates fields are being exported to Excel with 949998 and
when there is a date in, for example 9/30/2007, in excel it displays
as 39355.3333333333

Have you formatted the cells in Excel to display dates?

 

[Cass]

When in doubt about property names, use the object browser -- F2 in VBA.

"Notes" = Body
Categories -- that's the correct name.
Contacts = the Links collection, not a text property


Have you formatted the cells in Excel to display dates?

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54









- Show quoted text -

I went back and did that and thats where my last reply came from.

"all my dates fields with no dates, which say "None" by default in the
outlook form are being imported into excel as 1/1/4501. How do I get
excel to just leave it blank? "

Also thanks for the F2 tip. So this means that I won't be able to add
the Contacts field to the worksheet?

 

[Sue Mosher [MVP-Outlook]]

It's the Notes field and the Categories field. The following doesn't

Show more code. We have no way of knowing what the parent object is. Also, what error are you getting? Is this code in Excel or Outlook VBA?
outlook form are being imported into excel as 1/1/4501. How do I get
excel to just leave it blank? <

Check the value of the Outlook property and if it's #1/1/4501#, then don't put any value in the Excel cell.

I don't know why you're not seeing other values as dates. That still sounds like an Excel cell formatting issue.

So this means that I won't be able to add
the Contacts field to the worksheet?

No, it means that there is no Contacts field. Instead, there is a Links collection. If you want to add data from that collection to the worksheet, you will need to iterate the items in that collection.

 

[Cass]

I don't know if you're not seeing my latest posts or what? Should I be
using google groups?

Sorry I thought that you could still see the entire block of code from
the first post. This code is in Excel VBA. I am getting this error:
Run-time error '1004': Application-defined or object-defined error.
When I click debug it highlights this piece of code: "Cells(i,
13).Value = .Links" from the code below. This is the code.

Sub Import_Contacts()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olColItems As Outlook.Items
Dim olItem As Object
Dim strDummy As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim i As Long
Application.ScreenUpdating = False
'Instantiate the MS Outlook objects.
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.PickFolder
If olFolder Is Nothing Then
GoTo ExitSub
ElseIf olFolder.DefaultItemType <> olContactItem Then
MsgBox "The selected folder does not contain contacts.",
vbOKOnly
GoTo ExitSub
ElseIf olFolder.Items.Count = 0 Then
MsgBox "No contacts to import.", vbOKOnly
GoTo ExitSub
End If
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
With wsSheet
.Range("A1").CurrentRegion.Clear
.Cells(1, 1).Value = "Utility"
.Cells(1, 2).Value = "CityStateZip"
.Cells(1, 3).Value = "MainContact"
End With
Set olColItems = olFolder.Items
i = 2
For Each olItem In olColItems
If TypeName(olItem) = "ContactItem" Then
With olItem
If InStr(olItem.FileAs, strDummy) > 0 Then
Cells(i, 1).Value = .UserProperties("Utility")
Cells(i, 2).Value = .UserProperties("CityStateZip")
Cells(i, 3).Value = .UserProperties("MainContact")
Cells(i, 4).Value = .UserProperties("MainPhone")
Cells(i, 5).Value = .Email1Address
Cells(i, 6).Value = .UserProperties("Fax")
Cells(i, 7).Value = .UserProperties("AltContact1")
Cells(i, 8).Value = .UserProperties("AltPhone1")
Cells(i, 9).Value = .UserProperties("AltContact2")
Cells(i, 10).Value = .UserProperties("AltPhone2")
Cells(i, 11).Value
= .UserProperties("DistributorContact")
Cells(i, 12).Value
= .UserProperties("DistributorPhone")
Cells(i, 13).Value = .Links
Cells(i, 14).Value = .UserProperties("NoRadioAccts")
Cells(i, 15).Value = .UserProperties("OrigOrderNo")
Cells(i, 16).Value = .UserProperties("BillingInc10G")
Cells(i, 17).Value = .UserProperties("BillingInc100G")
Cells(i, 18).Value = .UserProperties("BillingInc1000G")
Cells(i, 19).Value = .UserProperties("BillingInc1CF")
Cells(i, 20).Value = .UserProperties("BillingInc10CF")
Cells(i, 21).Value = .UserProperties("BillingInc100CF")
Cells(i, 22).Value
= .UserProperties("TRLResolution10G")
Cells(i, 23).Value
= .UserProperties("TRLResolution100G")
Cells(i, 24).Value
= .UserProperties("TRLResolution1000G")
Cells(i, 25).Value
= .UserProperties("TRLResolution1CF")
Cells(i, 26).Value
= .UserProperties("TRLResolution10CF")
Cells(i, 27).Value
= .UserProperties("TRLResolution100CF")
Cells(i, 28).Value = .Body
Cells(i, 29).Value = .Categories
Cells(i, 30).Value
= .UserProperties("EZSoftwareVersion")
Cells(i, 67).Value = .UserProperties("Service01")
Cells(i, 68).Value = .UserProperties("Service01Date")
Cells(i, 69).Value
= .UserProperties("Service01Description")
Else
Cells(i, 1).Value = .FullName
Cells(i, 2).Value = .HomeAddressStreet
Cells(i, 3).Value = .HomeAddressPostalCode
Cells(i, 4).Value = .HomeAddressCity
Cells(i, 5).Value = .FullName
Cells(i, 6).Value = .Email1Address
End If
End With
i = i + 1
End If
Next olItem
ExitSub:
Set olItem = Nothing
Set olColItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End Sub


I am seeing the values of all the entered dates. However the date
fields which have "None" listed in them in outlook are being exported
to Excel as 1/1/4501. There is no initial value in the property in
outlook. It's just a normal date field.
How do I do that?

 

[Sue Mosher [MVP-Outlook]]

It wasn't clear whether you were using the same code or had made changes to it.

Again, Links is a collection. It returns no string value. You must iterate it to get whatever you want out of it, e.g.

For Each lnk in olItem.Links
strLinks = strLinks & ", " & lnk.Name
Next
strLinks = Mid(strLinks, 3)

I don't see that you've implemented a check for dates with the value #1/1/4501# yet.