Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Importing GAL
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
 
Posts: n/a
Default Importing GAL
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

Reply With QuoteReply With Quote
  #2   Report Post  
Bob Phillips
 
Posts: n/a
Default
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

" wrote in
message ups.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



Reply With QuoteReply With Quote
  #3   Report Post  
PraetorianPrefect
 
Posts: n/a
Default

========

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



" wrote
in
message ups.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
Reply With QuoteReply With Quote
  #4   Report Post  
PraetorianPrefect
 
Posts: n/a
Default

The limit is set to 2000 which is but a small portion of the GAL.
Instead of limiting it to 2000 entries, I would like to extract "US" as
the country.

Again, 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

" wrote
in
message ups.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
Reply With QuoteReply With Quote
  #5   Report Post  
brettdj
 
Posts: n/a
Default

Hi PraetorianPrefect, Bob

The code will handle up to 65535 entries, ie a whole worksheet. It
handles 40,000 addresses or so for my company.

The 2000 reference in the code is a message for the code to dump the
variant array in 2000 record chunks.

As Bob suggested you can filter the records by location

Cheers

Dave


--
brettdj
------------------------------------------------------------------------
brettdj's Profile: http://www.excelforum.com/member.php...fo&userid=3903
View this thread: http://www.excelforum.com/showthread...hreadid=376364

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Importing Text Files smith_gw Excel Discussion (Misc queries) 1 May 5th 05 10:42 PM
Importing .txt data files increases .xls file size BrianJ Excel Discussion (Misc queries) 1 January 29th 05 02:02 PM
How to import a path/filename when importing data into an XML list cxparker Excel Worksheet Functions 0 December 7th 04 10:13 PM
Importing Question! Otto Moehrbach Excel Discussion (Misc queries) 0 November 26th 04 07:04 PM
S.O.S :importing excell data into word villi Excel Discussion (Misc queries) 0 November 25th 04 08:37 PM


All times are GMT +1. The time now is 08:58 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement