MAPI constant won't recognize value in form

G

Guest

I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
 
G

Guest

The name of the server by itself is not a valid parameter for Session.Logon.
You need either the name of an existing Outlook mail name or, for a "dynamic
profile," both the server and mailbox name. See
http://www.cdolive.com/cdo5.htm#SendMessage
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers




SCrowley said:
I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
Click to expand...
 
G

Guest

Thank you Sue. Actually I used the wrong terminology. The mail name
"[******-*******]" is what is in the actual code. I called it the server
name. I'm actually accessing the "folder" but can not access the data in the
forms. Even though my code below is "commented out" I've tried them all and
keep getting a MAPI error.
--
Thank you,
(e-mail address removed)


Sue Mosher said:
The name of the server by itself is not a valid parameter for Session.Logon.
You need either the name of an existing Outlook mail name or, for a "dynamic
profile," both the server and mailbox name. See
http://www.cdolive.com/cdo5.htm#SendMessage
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers




SCrowley said:
I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
Click to expand...
Click to expand...
 
G

Guest

I left out a word. Session.Logon takes an OUtlook mail *profile* name as a
parameter. I'm not sure if that's what you mean by a "mail name."

At the very least, you need an On Error Resume Next statement to handle the
scenario where the property has never been set, in which case no
corresponding field will exist on the item.

You can check property names at http://www.cdolive.com/cdo10.htm or with
OUtlook Spy or MFCMAPI.

FWIW, why are you using all those GetNext statements? Why not get the folder
by name from the Folders collection?
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers




SCrowley said:
Thank you Sue. Actually I used the wrong terminology. The mail name
"[******-*******]" is what is in the actual code. I called it the server
name. I'm actually accessing the "folder" but can not access the data in the
forms. Even though my code below is "commented out" I've tried them all and
keep getting a MAPI error.
--

Sue Mosher said:
The name of the server by itself is not a valid parameter for Session.Logon.
You need either the name of an existing Outlook mail name or, for a "dynamic
profile," both the server and mailbox name. See
http://www.cdolive.com/cdo5.htm#SendMessage


SCrowley said:
I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
Click to expand...
Click to expand...
Click to expand...
 
G

Guest

Thanks again! You're right about the mail name. As far as all the GetNexts,
awesome. I'm so new at this which is why I love all these resources. Now if I
could just learn how to piece it all together.
--
Thank you,
(e-mail address removed)


Sue Mosher said:
I left out a word. Session.Logon takes an OUtlook mail *profile* name as a
parameter. I'm not sure if that's what you mean by a "mail name."

At the very least, you need an On Error Resume Next statement to handle the
scenario where the property has never been set, in which case no
corresponding field will exist on the item.

You can check property names at http://www.cdolive.com/cdo10.htm or with
OUtlook Spy or MFCMAPI.

FWIW, why are you using all those GetNext statements? Why not get the folder
by name from the Folders collection?
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers




SCrowley said:
Thank you Sue. Actually I used the wrong terminology. The mail name
"[******-*******]" is what is in the actual code. I called it the server
name. I'm actually accessing the "folder" but can not access the data in the
forms. Even though my code below is "commented out" I've tried them all and
keep getting a MAPI error.
--

Sue Mosher said:
The name of the server by itself is not a valid parameter for Session.Logon.
You need either the name of an existing Outlook mail name or, for a "dynamic
profile," both the server and mailbox name. See
http://www.cdolive.com/cdo5.htm#SendMessage


:

I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
Click to expand...
Click to expand...
Click to expand...
 
G

Guest

Thank you SUE!!!! Works like a charm!!
--
Thank you,
(e-mail address removed)


Sue Mosher said:
I left out a word. Session.Logon takes an OUtlook mail *profile* name as a
parameter. I'm not sure if that's what you mean by a "mail name."

At the very least, you need an On Error Resume Next statement to handle the
scenario where the property has never been set, in which case no
corresponding field will exist on the item.

You can check property names at http://www.cdolive.com/cdo10.htm or with
OUtlook Spy or MFCMAPI.

FWIW, why are you using all those GetNext statements? Why not get the folder
by name from the Folders collection?
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers




SCrowley said:
Thank you Sue. Actually I used the wrong terminology. The mail name
"[******-*******]" is what is in the actual code. I called it the server
name. I'm actually accessing the "folder" but can not access the data in the
forms. Even though my code below is "commented out" I've tried them all and
keep getting a MAPI error.
--

Sue Mosher said:
The name of the server by itself is not a valid parameter for Session.Logon.
You need either the name of an existing Outlook mail name or, for a "dynamic
profile," both the server and mailbox name. See
http://www.cdolive.com/cdo5.htm#SendMessage


:

I'm trying to clean our data in our Corporate Contacts folder (Exchange
2003/Outlook 2003).

I found different codes already written and am trying to customize it.
Problem I'm running into is when I'm testing different strings I keep getting
MAPI not found error. Do you see where I've missed a step or am using the
wrong constant? Thanks. (I have changed server name and folder names for this
post)

Private Sub CommandButton1_Click()

'Have to create a CDO session
'Load CDO feature for Outlook and then put in a reference for CDO 1.21
Library to get "MAPI"
Dim cdosession
Set cdosession = CreateObject("MAPI.Session")
cdosession.Logon "[Name of Server]"

'Access Public Folder

Set oInfoStores = cdosession.InfoStores
Set oInfoStore = oInfoStores("Public Folders")
Set oRootFolder = oInfoStore.RootFolder
Set oFolders = oRootFolder.Folders
'Get Access To Favorites under Public Folders
Set oFolder = oFolders.GetFirst
'Get access to "Public Folder"
Set oFolder = oFolders.GetNext
MsgBox oFolder.Name

'Get into SubFolders under "[Name of Folder]"
'Use Get Next Method to Get to Contacts Folder

Set oFolders2 = oFolder.Folders
Set oFolder2 = oFolders2.GetFirst
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext
Set oFolder2 = oFolders2.GetNext

'Add code above here

MsgBox oFolder2.Name

'Get message collection from Contacts Subfolder

Set oMessages2 = oFolder2.Messages
Set oAddr2 = oMessages2.GetFirst

Do While Not oAddr2 Is Nothing
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'& oAddr.Fields(CdoPR_SURNAME) '& vbCrLf
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)
'& oAddr2.Fields(CdoPR_SURNAME) '& vbCrLf & _
'"Address: " & oAddr.Fields(CdoPR_STREET_ADDRESS)
'oAddr.Fields(CdoPR_GIVEN_NAME) = "Brian"
'oAddr.Fields(CdoPR_SURNAME) = "Mason"
'oAddr.Fields(CdoPR_TITLE) = "MCSE"
'oAddr.Fields(CdoPR_HOME_ADDRESS_STREET) = "12345 Low Street"
'oAddr2.Fields(CdoPR_LOCALITY) = "New Horizons"
'oAddr2.Fields(CdoPR_GIVEN_NAME) = Replace(oAddr2.Fields(CdoPR_GIVEN_NAME),
"Brian", "Bob")
'oAddr2.Fields(CdoPR_STREET_ADDRESS) =
Replace(oAddr2.Fields(CdoPR_STREET_ADDRESS), "321", "445")
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "Street", "Ave.")
'oAddr2.Fields(CdoPR_POSTAL_CODE) =
Replace(oAddr2.Fields(CdoPR_POSTAL_CODE), "28134", "12345")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Parkway", "Pkwy.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Drive", "Dr.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Boulevard", "Blvd.")
'oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_HOME_ADDRESS_STREET), "Avenue", "Ave.")

oAddr2.Update
'MsgBox "Name: " & oAddr2.Fields(CdoPR_GIVEN_NAME) & " " &
oAddr2.Fields(CdoPR_SURNAME)
'MsgBox "Address: " & oAddr2.Fields(CdoPR_STREET_ADDRESS)

Set oAddr2 = oMessages2.GetNext
Loop

MsgBox "Your data is cleansed!!"


'This shows infostores in the project - mailbox for administrator and Public
Folders

'For i = 1 To oInfoStores.Count
'Set oInfoStore = oInfoStores(i)
'MsgBox oInfoStore.Name
'Next

'Make Output to Excel

Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)
objWS.Cells(1, 1) = "Contact List"
objWS.Cells(2, 1) = " FirstName"
objWS.Cells(2, 2) = " LastName"
objWS.Cells(2, 3) = " Address"
objWS.Cells(2, 4) = " City"
objWS.Cells(2, 5) = " State"
objWS.Cells(2, 6) = " ZipCode"

'Get Count of Messages using the Count Property

Dim intCount1
intCount1 = oMessages2.Count

Set oAddr2 = oMessages2.GetFirst

'MsgBox oAddr2.Fields(CdoPR_SURNAME)

If oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_CITY) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "" Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE) = "N/A"
ElseIf oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = 0 Then
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE) = "N/A"
'ElseIf oAddr2.Fields(CdoPR_FULLNAME) = "" Then
'oAddr2.Fields(CdoPR_FULLNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_SURNAME) = 0 Then
oAddr2.Fields(CdoPR_SURNAME) = "N/A"
ElseIf oAddr2.Fields(CdoPR_FORM_CATEGORY) = " " Then
oAddr2.Fields(CdoPR_FORM_CATEGORY) = "N/A"
End If

'objWS.Cells(3, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(3, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(3, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
objWS.Cells(3, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(3, 5) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(3, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)

intRow = 3

For i = 1 To (intCount1 - 1)
intRow = intRow + 1

Set oAddr2 = oMessages2.GetNext

'MsgBox oAddr2.Fields(CdoPR_GIVEN_NAME)
'oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET) =
Replace(oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET), "St.", "Ave.")


'objWS.Cells(intRow, 1) = oAddr2.Fields(CdoPR_FULLNAME)
'objWS.Cells(intRow, 2) = oAddr2.Fields(CdoPR_SURNAME)
'objWS.Cells(intRow, 3) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STREET)
'objWS.Cells(intRow, 4) = oAddr2.Fields(CdoPR_FORM_CATEGORY)
'objWS.Cells(intRow, 5) =
oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_STATE_OR_PROVINCE)
'objWS.Cells(intRow, 6) = oAddr2.Fields(CdoPR_BUSINESS_ADDRESS_POSTAL_CODE)


Next

objWS.Application.Visible = True
objWS.Activate
Dim j
Set objRange = objWS.Range(objWS.Cells(2, 1), objWS.Cells(intRow, 6))
For j = 1 To 6
objRange.Columns(j).EntireColumn.AutoFit
Next


Set objWS = Nothing






Set oAddr2 = Nothing
cdosession.Logoff


End Sub

Private Sub UserForm_Click()

End Sub
Click to expand...
Click to expand...
Click to expand...
 
Top