Public Folders Contact

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,

Does anyone know how to set Public Folders Contact to be displayed on
Microsoft Outlook Address book automatically without users having to enable
it on the properties of the contact?

Thank you in advance.

William A. J.
 
Each user could run a script to set the ShowAsOutlookAB property for that folder.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
This is what I have in mind. I prepare a script for user to run and
distribute it by Group Policy. Tell me if I am wrong. I just have to really
put aside the technical part from users. What script would you suggest for
this matter? To be honest I am a total newbie when it comes to Windows
scripting.

Thank you.

William A. J.
 
Like all Office programs, Outlook has a rich object model for external automation, but there's a potential hitch: Such a script will work only if the user is running Outlook with the desired mail profile. Do you set up Outlook using the ORK tools so that all users have a mail profile of the same name as their default profile? If so, then you should be able to use something like this in a .vbs script:

On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "Profile Name", "", "", True
blnWeStartedOL = True
End If
Set objFolder = GetFolder(objNS, "Public Folders\All Public Folders\Parent Folder\Contacts Folder")
If Not objFolder Is Nothing Then
objFolder.ShowAsOutlookAB = True
End If
Set objFolder = Nothing
If blnWeStartedOL Then
objNS.Logoff
objOL.Quit
End If
set objNS = Nothing
Set objOL = Nothing

Function GetFolder(objNS, FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim fldr
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit Function
Next
Set GetFolder = fldr
End Function

If you don't know the profile name, then use this Logon statement instead:

objNS.Logon "", "", True, True

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Hi Sue,

Everything is done manually as the company does not a standard IT policy
yet. Outlook profile is created when a user logs on for the first time on a
PC. People do not usually move around. They stick with the same PC all the
time. Do you think the script you gave me would work on this kind of
environment?

Thank you.

William A. J.
 
The best way to find out is to try it.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Hi Sue,

I got an error message while trying to run the script you gave me. It says
something like:
Line: 27
Char: 7
Error: Name redefined
Code: 800A0411
Source: Microsoft VBScript compilation error

It looks like there is a problem with objNS.

Thank you.

William A. J.
 
Sorry, I left out a couple of statements:

If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "Profile Name", "", "", True
blnWeStartedOL = True
Else
Set objNS = objOL.GetNamespace("MAPI")
End If

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
So, what's the statement on line 27, the line where the code error occurred?

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Hi Sue,

Let me correct myself a little bit. The original error was at line 27. You
made corrections and the error is now at line 29. I checked and figured out
the error is at the same data, which is at "Dim objNS".

This is the script I put together based on your advice:

---
On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "", "", True, True
blnWeStartedOL = True
Else
Set objNS = objOL.GetNamespace("MAPI")
End If
Set objFolder = GetFolder(objNS, "Public Folders\All Public
Folders\Address Book\Jackgreen")
If Not objFolder Is Nothing Then
objFolder.ShowAsOutlookAB = True
End If
Set objFolder = Nothing
If blnWeStartedOL Then
objNS.Logoff
objOL.Quit
End If
set objNS = Nothing
Set objOL = Nothing

Function GetFolder(objNS, FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim fldr
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit Function
Next
Set GetFolder = fldr
End Function
 
A simple Dim statement wouldn't raise an error. Maybe there's some extraneous character on that line.

Please quote earlier messages in this thread or we won't remember what it's about.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Hi Sue,

Sorry for that. Here it is the full conversation we have had. I did a count
and error line before the correction (27) and after the correction (29), both
are pointing at "Dim objNS"

The error message says:
Line: 29
Char: 7
Error: Name redefined
Code: 800A0411
Source: Microsoft VBScript compilation error

Below is the script I have put together:

---
On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "", "", True, True
blnWeStartedOL = True
Else
Set objNS = objOL.GetNamespace("MAPI")
End If
Set objFolder = GetFolder(objNS, "Public Folders\All Public
Folders\Address Book\Jackgreen")
If Not objFolder Is Nothing Then
objFolder.ShowAsOutlookAB = True
End If
Set objFolder = Nothing
If blnWeStartedOL Then
objNS.Logoff
objOL.Quit
End If
set objNS = Nothing
Set objOL = Nothing

Function GetFolder(objNS, FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim fldr
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit Function
Next
Set GetFolder = fldr
End Function
---

Thank you.

William A. J.
 
Ah, my eyes adjusted, and I can see it now. Let me show you the problem:

Function GetFolder(objNS, FolderPath)
<snip>
Dim objNS

See what's wrong? There are two objNS declarations. You don't need the 2nd one. My bad. Sorry.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
For Outlook 2019 and Exchange 2019:

On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
objNS.Logon "", "", True, True
blnWeStartedOL = True
Else
Set objNS = objOL.GetNamespace("MAPI")
End If

Set objFolder = GetFolder(objNS, "Public contacts")
If Not objFolder Is Nothing Then
objFolder.ShowAsOutlookAB = True
wscript.echo "OK"
ELSE
wscript.echo "Error"
End If
Set objFolder = Nothing
If blnWeStartedOL Then
objNS.Logoff
objOL.Quit
End If
set objNS = Nothing
Set objOL = Nothing

Function GetFolder(objNS, FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim fldr
Dim i

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")
'set the root folder
Set fldr = objNS.GetDefaultFolder(18)
If Err <> 0 Then
wscript.echo "Root folder not exist"
Exit Function
End If

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 0 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then
wscript.echo "Folder not exist: " & aFolders(i)
Exit Function
End If
Next
Set GetFolder = fldr
wscript.echo fldr
End Function
 
Back
Top