"David" <consulttech2***@hotmail.com> wrote in message
news:91e03912-196f-4ad3-968a-01ed1bbc1551@l16g2000yqo.googlegroups.com...
> Hello!  I am a VBA programmer who has programmed a wonderful VBA
> solution to export contacts to a custom database.  The problem (or
> challenge, as it were) is that the the customer wants to have
> delegates do the export.  Is there an easy way (or any way) through
> VBA (or anything else) that tells Outlook that a delegate is accessing
> contacts and points to the proper folder?  I can't seem to get it to
> work -- Most important, I can't seem to pass a MapiFolder as a
> function argument, just a string, which means that I can't read
> backwards to the contact folder I was in (some people have more than
> one contact folder.)
>
> Any help at all would be appreciated.  Thank you.
>
> David

"David" <consulttech2***@hotmail.com> wrote in message
news:8aa598ec-e8cf-4ede-8023-725dd88fd12d@v39g2000yqm.googlegroups.com...
> Works great if I am doing this from my own PC.  If I try to do this
> where I am a delegate of someone else, I can't get to their folder....
>
>
> 't is userproperty argument
> 'f and v are folder arguments
> Sub usbProcessContacts(t As String, f As String, v As Variant)
>
> 'Outlook Items
> Dim APPOL As Outlook.Application
> Dim NS As Outlook.NameSpace
> Dim fld1 As Outlook.MAPIFolder
> Dim fld2 As Outlook.MAPIFolder
> Dim l As Long
> Dim strMailbox As String
> Dim cnt1 As ContactItem
> Dim strAddress As String
> Dim strAdr1 As String
> Dim strAdr2 As String
> Dim int1 As Integer
> Dim flg1 As Boolean
> Dim flda() As String
> Dim inta As Integer
> Dim intStart As Integer
>
>
> 'Access Items
> Dim cnn As ADODB.Connection
> Dim rs1 As ADODB.Recordset
>
> Set cnn = New ADODB.Connection
>
> cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
> & "c:\marketing\Main Contact Form Database.mdb"
>
> cnn.Open
>
> Set APPOL = New Outlook.Application
> Set NS = APPOL.GetNamespace("Mapi")
> Set fld1 = NS.GetFolderFromID(f, v).Folders("Contacts")
> 'Set fld1 = NS.GetDefaultFolder(olFolderContacts)
> Debug.Print fld1.Name
>
> For l = fld1.Items.Count To 1 Step -1
>
>    If fld1.Items(l).Class = 40 Then
>        If fld1.Items(l).UserProperties(t) = True Then
>
>        Set rs1 = New ADODB.Recordset
>            rs1.Open t, cnn, adOpenKeyset, adLockOptimistic
>                With rs1
>                strAddress = fld1.Items(l).MailingAddressStreet &
> fld1.Items(l).MailingAddressCity & fld1.Items
> (l).MailingAddressPostalCode & fld1.Items(l).MailingAddressState & "."
>
>                If Len(strAddress) > 1 Then
>
>                    .AddNew
>                        .Fields("OriginalOwner") = strMailbox
>                        .Fields("FirstName") = fld1.Items(l).FirstName
>                        .Fields("LastName") = fld1.Items(l).LastName
>                        .Fields("FullName") = fld1.Items(l).FullName
>                        .Fields("FileAs") = fld1.Items(l).FileAs
>                        .Fields("CompanyName") = fld1.Items
> (l).CompanyName
>                        .Fields("Title") = fld1.Items(l).Title
>                        .Fields("MailingAddressCity") = fld1.Items
> (l).MailingAddressCity
>
>                        strAdr1 = fld1.Items(l).MailingAddressStreet
>                        int1 = InStr(1, fld1.Items
> (l).MailingAddressStreet, ",")
>                        If int1 > 0 Then flg1 = True
>                        int1 = InStr(1, strAdr1, Chr(13),
> vbTextCompare)
>                        If int1 > 1 Then
>                            strAdr1 = Left(strAdr1, int1 - 1)
>                            If flg1 Then
>                                strAdr1 = strAdr1 & Mid(fld1.Items
> (l).MailingAddressStreet, int1 + 2, Len(fld1.Items
> (l).MailingAddressStreet))
>                            Else
>                                strAdr1 = strAdr1 & ", " & Mid
> (fld1.Items(l).MailingAddressStreet, int1 + 2, Len(fld1.Items
> (l).MailingAddressStreet))
>                            End If
>                            .Fields("MailingAddressStreet") = strAdr1
>
>                            'strAdr1 = fld1.Items
> (l).MailingAddressStreet
>                            'int1 = InStr(1, strAdr1, Chr(10),
> vbTextCompare)
>
>                            'strAdr1 = Right(strAdr1, int1 + 1)
>                            '.Fields("mailingaddressPostOfficeBox") =
> strAdr1
>                        Else
>                            .Fields("MailingAddressStreet") =
> fld1.Items(l).MailingAddressStreet
>                        End If
>
>                        .Fields("mailingaddresscountry") = fld1.Items
> (l).MailingAddressCountry
>                        .Fields("MailingAddresspostalCode") =
> fld1.Items(l).MailingAddressPostalCode
>                        .Fields("Mailingaddressstate") = fld1.Items
> (l).MailingAddressState
>                        .Fields("Email") = fld1.Items(l).Email1Address
>                        .Fields("ExportDate") = Date
>                    .Update
>                Else
>                    'do nothing
>                End If
>
>                End With
>            rs1.Close
>
>        End If
>    Else
>        'do nothing
>    End If
>
> Next l
>
> cnn.Close
> Set rs1 = Nothing
> Set cnn = Nothing
>
>
> MsgBox "Finished Exporting!", vbOKOnly + vbInformation, "Finished!"
>
>
> End Sub

"David" <consulttech2***@hotmail.com> wrote in message
news:4c4a89d1-1db7-4163-8223-e07c270e7d5a@s24g2000vbp.googlegroups.com...
> You actually answered my question (and I apologize for the
> vagueness.)  Now, how do I return the username of the delegate whose
> contacts folder I am in while I am in it?
>
> David