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?