Results 1 to 9 of 9
  1. #1
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Drop an Outlook Collection into an Excel Range? (Excel/Outlook 2000 +)

    I have been trying to rework the code from <!post=Excel Post,509767>Excel Post<!/post>, and I can run a loop through -each- item in the ContactItem.ItemProperties and drop it into a Cell offset, or I can run the ContactItem.ItemProperties into a string Array and drop them into the range, but either way is slooooooow. Is there a way I can drop the entire ContactItem.ItemProperties collection directly into the Range? The stripped down code follows:

    Sub contactsimporter()
    Dim fldr As MAPIFolder
    Dim lngC As Long

    Set fldr = CreateObject("Outlook.Application").Session.PickFo lder
    If fldr.DefaultItemType = olContactItem Then
    With fldr.Items(lngC)
    If .Class = olContact Then
    ThisWorkbook.ActiveSheet.Range(Cells(lngC, 1), _
    Cells(lngC, fldr.Items(1).ItemProperties.Count)) = .ItemProperties ' doesn't work
    ThisWorkbook.ActiveSheet.Range(Cells(lngC, 1), _
    Cells(lngC, fldr.Items(1).ItemProperties.Count)) = Array(.ItemProperties) ' doesn't work
    End If
    End With
    Next lngC
    End If
    Set fldr = Nothing
    End Sub
    -John ... I float in liquid gardens
    UTC -7ąDS

  2. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Drop an Outlook Collection into an Excel Range? (Excel/Outlook 2000 +)

    John,
    How slow is slow?
    It might help if you read all the itemproperties for all the items into an array and then dumped that into the spreadsheet?
    Regards,
    Rory

    Microsoft MVP - Excel

  3. #3
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Drop an Outlook Collection into an Excel Range? (Excel/Outlook 2000 +)

    I tried something like this (recovered from commented-out code, so there may be errors) but it's not very fast:

    Sub contactsimporter()
    Dim fldr As MAPIFolder
    Dim lngC As Long , lngP As Long
    Dim intPropCount As Integer
    Dim strContactProperties() As String

    Set fldr = CreateObject("Outlook.Application").Session.PickFo lder
    If fldr.DefaultItemType = olContactItem Then
    intPropCount = fldr.Items(1).ItemProperties.Count
    ReDim strContactProperties(intPropCount)
    For lngC = 2 To fldr.Items.Count
    With fldr.Items(lngC)
    If .Class = olContact Then
    For lngP = 0 To intPropCount - 1
    On Error Resume Next ' some ContactItem.ItemProperties yield a VB error, dunno why
    strContactProperties(lngP) = .ItemProperties.Item(lngP).Value ' into the array
    ThisWorkbook.ActiveSheet.Range(Cells(lngC, 1), _
    Cells(lngC, intPropCount)) = strContactProperties() ' from the array to the range
    On Error GoTo 0
    Next lngP
    End If
    End With
    Next lngC
    End If
    Set fldr = Nothing
    Set strContactProperties() = Nothing
    End Sub

    Anything you can see that would speed it up? Or were you thinking of one meta-array for all ContactItems in the Folder? - I'll have to give that a go.
    -John ... I float in liquid gardens
    UTC -7ąDS

  4. #4
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Drop an Outlook Collection into an Excel Range? (Excel/Outlook 2000 +)

    Putting it all in one big array is certainly faster, but not as fast as the native export method that isn't exposed to VBA. I still had time for a long <img src=/S/coffeetime.gif border=0 alt=coffeetime width=32 height=48> break. Thanks for your help, Rory. I'll post my code back to the Excel thread.
    -John ... I float in liquid gardens
    UTC -7ąDS

  5. #5
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Drop an Outlook Collection into an Excel Range? (Excel/Outlook 2000 +)

    John,
    To get access to the GAL, you might try something like:
    <pre>Sub ImportContacts()
    Dim ADOConn As ADODB.Connection
    Dim ADORS As ADODB.Recordset
    Dim strConn As String
    Set ADOConn = New ADODB.Connection
    Set ADORS = New ADODB.Recordset

    With ADOConn
    .Provider = "Microsoft.JET.OLEDB.4.0"
    .ConnectionString = "Exchange 4.0;" _
    & "MAPILEVEL=Mailbox - mailboxnamehere|;" _
    & "PROFILE=MS Exchange Settings;" _
    & "TABLETYPE=1;DATABASE=C:WINDOWSTEMP;"
    .Open

    End With

    With ADORS
    .Open "Select * from [Global Address List]", ADOConn, adOpenStatic, _
    adLockReadOnly
    .MoveFirst
    End With
    ActiveSheet.Range("A1").CopyFromRecordset ADORS
    ADORS.Close
    Set ADORS = Nothing
    Application.ScreenUpdating = True
    End Sub
    </pre>


    I have not yet figured out how to get the Contacts folder but I'm not sure if my problems are related to the fact I'm using a VPN to work (doubt it though). For a PAB on non-Exchange, I think it's easier.
    Regards,
    Rory

    Microsoft MVP - Excel

  6. #6
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Drop an Outlook Collection into an Excel Range

    I had no idea this was possible... To get to Contacts, try using TABLETYPE=0, at least for top-level Contacts folder. To access a subfolder, I think you have to use a complete path in the MAPILEVEL parameter.

    <code>Sub ListExchangeTables()
    ' Project references must include ADO and ADO Extensibility (ADOX)
    Dim ADOConn As ADODB.Connection
    Dim ADORS As ADODB.Recordset
    Dim catDB As ADOX.Catalog
    Dim tblDB As ADOX.Table
    ' Connect to Exchange
    Set ADOConn = New ADODB.Connection
    With ADOConn
    .Provider = "Microsoft.JET.OLEDB.4.0"
    ' Set TABLETYPE=1 to access Address Books
    .ConnectionString = "Exchange 4.0;" _
    & "MAPILEVEL=Mailbox - <img src=/w3timages/censored.gif alt=censored border=0>|;" _
    & "PROFILE= <img src=/w3timages/censored.gif alt=censored border=0>;" _
    & "TABLETYPE=0;DATABASE=C:WINDOWSTEMP;"
    .Open
    End With
    ' Open the catalog
    Set catDB = New ADOX.Catalog
    catDB.ActiveConnection = ADOConn
    'Stop 'to inspect the Locals window
    ' List tables (can't see a way to access subfolders)
    For Each tblDB In catDB.Tables
    'Dump to your choice of output medium; this is Word
    ActiveDocument.Content.InsertAfter tblDB.Name & vbCrLf
    Next
    ' Clean up objects
    Set tblDB = Nothing
    Set catDB = Nothing
    ADOConn.Close
    Set ADOConn = Nothing
    End Sub</code>

  7. #7
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Drop an Outlook Collection into an Excel Range

    OK, slow down, you two. <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15> <img src=/S/laugh.gif border=0 alt=laugh width=15 height=15> How do I use this for a standalone PST? Where and how do I find the correct parameters for "MAPILEVEL=<?>" and "PROFILE= <?>"?
    -John ... I float in liquid gardens
    UTC -7ąDS

  8. #8
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Drop an Outlook Collection into an Excel Range

    > How do I use this for a standalone PST?
    I don't know whether that is possible.

    > Where and how do I find the correct parameters for "MAPILEVEL=<?>" and "PROFILE= <?>"?
    When I used the original values in Rory's post, I got a "choose profile" dialog. When I changed the parameters, I got an error. So then I put in the exactly correct information and it worked. Very odd.

    There were some pages on the web when Googled the parameters; one of them showed a detailed path for MAPILEVEL. That might help. I found this on "The Code Project":
    <hr>Connecting to an Outlook 2000 personal mail box using the JET OLE DB Provider: (By J. Cardinal)
    <pre>strConnect = _T("Provider=Microsoft.Jet.OLEDB.4.0;Outlook 9.0;"
    "MAPILEVEL=;DATABASE=C:Temp;")</pre>

    Replace c:temp with any temporary folder. It will create a schema file in that folder when you open it which shows all the fields available. Blank MAPILEVEL indicates top level of folders).<hr>
    I assume you would change the Outlook version from 9.0 to whatever is appropriate for your environment, and ditch the "_T" part...

  9. #9
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Drop an Outlook Collection into an Excel Range

    Jefferson,
    The problem I was having was that issuing a "Select * from Contacts" query gave me an error of "query must contain at least one destination field" (or similar). I have now determined that to get at my Contacts folder as an Address Book, I needed to change the MAPILEVEL to:
    <pre>MAPILEVEL=Mailbox - mailboxnamehere|Outlook Address Book;</pre>


    and then the Select query runs just fine. It does not, however return the 150 odd Itemproperties I was getting using John's original method, so we may be barking up the wrong tree anyway! <img src=/S/grin.gif border=0 alt=grin width=15 height=15>
    Regards,
    Rory

    Microsoft MVP - Excel

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •