========

It dumps the entire GAL, which would exceed the limit in excel.

Thank you.

========

Bob Phillips Wrote:
> Surely, it dumps the data into an excel spreadsheet, so you then just
> use
> Excel's built-in filter on the location column.
>
> --
> HTH
>
> Bob Phillips
>
>
>
> "praetorian_prefect_2004@yahoo.com" praetorianprefect@gmail.com wrote
> in
> message news:1117815769.758961.94720@g49g2000cwa.googlegroups.com...-
> Below is the code to extract the GAL into excel. The question I have
> is how can I use this code to filter by country, i.e. "US". Thanks.
>
> Code was written by brettdj and can be found here
> http://www.vbaexpress.com/kb/getarticle.php?kb_id=222
>
> Option Explicit
> Const CdoAddressListGAL = 0
> Const CdoUser = 0
> Const CdoRemoteUser = 6
> #Const EarlyBind = True
>
> Sub GetGAL()
> 'Requires Excel 2000 as it uses Array
>
> Dim X As Variant, CDOList As Variant, TitleList As Variant,
> CDOitem
> As Variant
> Dim NumX As Long, ArrayDump As Long, i As Long, v As Long, u As
> Long
>
> 'Change the #Const to True to enable Early Binding
>
> #If EarlyBind Then
> Dim objSession As MAPI.Session, oFolder As MAPI.AddressList,
> oMessage As MAPI.AddressEntry
> Set objSession = New MAPI.Session
> CDOList = Array(CdoPR_DISPLAY_NAME, CdoPR_GIVEN_NAME,
> CdoPR_SURNAME, 972947486, CdoPR_ACCOUNT, _
> CdoPR_TITLE, CdoPR_OFFICE_TELEPHONE_NUMBER,
> CdoPR_MOBILE_TELEPHONE_NUMBER, CdoPR_PRIMARY_FAX_NUMBER, _
> CdoPR_COMPANY_NAME, CdoPR_DEPARTMENT_NAME, 974716958,
> CdoPR_STREET_ADDRESS, _
> CdoPR_LOCALITY, CdoPR_STATE_OR_PROVINCE, CdoPR_COUNTRY, _
> CdoPR_ASSISTANT, CdoPR_ASSISTANT_TELEPHONE_NUMBER)
> #Else
> Dim objSession As Object, oFolder As Object, oMessage As
> Object
> Set objSession = CreateObject("MAPI.Session")
> CDOList = Array(805371934, 973471774, 974192670, 972947486,
> 973078558, 974585886, _
> 973602846, 974913566, 975372318, 974520350, 974651422,
> 974716958, 975765534, _
> 975634462, 975699998, 975568926, 976224286, 976093214)
> #End If
>
> With objSession
> .Logon , , True, True
> Set oFolder = .GetAddressList(CdoAddressListGAL)
> End With
>
> TitleList = Array("GAL Name", "Given Name", "Surname", "Email
> address", "Logon", "Title Field", _
> "Telephone", "Mobile", "Fax", "CSG/Group", "Department",
> "Site", "Address", "Location", "State ", _
> "Country Field", "Assistant Name", "Assistant Phone")
>
> 'Grab 2000 records in one hit before writing to sheet
>
> ArrayDump = 2000
> Cells.Clear
>
> 'Add Titles
> With Range("A1").Resize(1, UBound(TitleList) + 1)
> .Formula = TitleList
> .HorizontalAlignment = xlCenter
> .Interior.ColorIndex = 35
> .Font.Bold = True
> .Font.Size = 12
> End With
>
> ReDim X(1 To ArrayDump, 1 To UBound(CDOList) + 1)
>
> On Error Resume Next
> 'Some fields may not exist
>
> 'Turn off screen updating
> Application.ScreenUpdating = False
> For Each oMessage In oFolder.AddressEntries
>
> Select Case oMessage.DisplayType
> Case CdoUser, CdoRemoteUser
> i = i + 1
> 'Reset variant array every after each group of
> records
> If i Mod (ArrayDump + 1) = 0 Then
>
> 'Check that records do notexceed one sheet
> If NumX * ArrayDump + i 65535 Then
> MsgBox "GAL exceeds 65535 entries -
> extraction
> stopped ", vbCritical + vbOKOnly
> GoTo FastExit
> End If
>
> 'Dump data
> NumX = NumX + 1
> Range("A2").Offset((NumX - 1) * ArrayDump,
> 0).Resize(ArrayDump, UBound(CDOList) + 1) = X
> ReDim X(1 To ArrayDump, 1 To UBound(CDOList) + 1)
>
> i = 1
> End If
> 'Display status to user
> If i Mod ArrayDump = 0 Then
> Application.StatusBar = "Entry " & i + u + NumX *
> ArrayDump & " of " & oFolder.AddressEntries.Count
> DoEvents
> End If
>
> v = 0
> ' Add detail to each address
> For Each CDOitem In CDOList
> v = v + 1
> X(i, v) = oMessage.Fields(CDOitem)
> Next
> Case Else
> u = u + 1
> End Select
> Next
>
> 'dump remaining entries
> Range("A2").Offset(NumX * ArrayDump, 0).Resize(ArrayDump,
> UBound(CDOList) + 1) = X
>
> 'cleanup
> FastExit:
> ActiveSheet.UsedRange.EntireRow.WrapText = False
> Cells.EntireColumn.AutoFit
>
> Application.StatusBar = ""
> Application.ScreenUpdating = True
>
> Set oFolder = Nothing
> Set objSession = Nothing
>
> End Sub
> -


--
PraetorianPrefect