I have a problem that is:

        I want to create an Server Exchange Folder report  from the
information that is on the Public Folder Resources under the Public
Information Store, but I cannot access the Public Information Store or the
Public Folder Resources.

        I would apreciate very much if someone could help me on this.

    Thank you

    Elisabete

Please don't post to so many groups - one or two is probably sufficient.

Dim g_Const_MBX
Dim g_Const_ReportFile
Dim CdoPR_ACCOUNT
Dim CdoPR_FOLDER_SIZE
Dim CdoPR_EMAIL
Dim CdoPR_CONTENT_COUNT
Dim CdoPR_CONTENT_UNREAD
Dim PR_EMS_AB_HOME_MTA

Dim PR_LAST_LOGON_TIME
Dim PR_LAST_LOGOFF_TIME

'Dim CdoPR_FOLDER_SIZE
Dim CdoPR_SUBFOLDERS
Dim PR_IPM_PUBLIC_FOLDERS_ENTRYID

' Enter the display name of the mailbox which you want have send the report
to
g_Const_MBX = "< Registry Scanner Workstation"

' Enter the path and filename of the report file
' if you use the extension csv it can be opened with Microsoft Excel
g_Const_ReportFile = "c:\temp\FolderReport.csv"

PR_IPM_PUBLIC_FOLDERS_ENTRYID = &H66310102 ' Public folder entry id

' MAPI properties not documented
'CdoPR_MAILBOX_SIZE   = &HE08001E  ' Size of the mailbox in byte
CdoPR_EMAIL          = &H39FE001E  ' SMTP address of the mailbox

' MAPI properties which are documented
CdoPR_ACCOUNT        = &H3A00001E  ' Alias
CdoPR_CONTENT_COUNT  = &H36020003  ' Count of all messages of the mailbox
CdoPR_CONTENT_UNREAD = &H36030003  ' Count of unread messages of the inbox
PR_EMS_AB_HOME_MTA   = &H8007001E  ' Home MTA needed to get the home server
name

CdoPR_FOLDER_SIZE    = &HE08001E  ' Size of the folder
CdoPR_SUBFOLDERS  = &H360A000B  ' True if subfolders found

' MAPI properties cannot be accessed with this script
PR_LAST_LOGON_TIME   = &H66A20040  ' Last logon time
PR_LAST_LOGOFF_TIME  = &H66A30040  ' Last logoff time

'---------------------------------------------------------------------------
---
' EVENT HANDLERS
'---------------------------------------------------------------------------
---

' DESCRIPTION: This event is fired when a new message is added to the folder
Public Sub Folder_OnMessageCreated
 'Not used
End Sub

' DESCRIPTION: This event is fired when a message in the folder is changed
Public Sub Message_OnChange
 'Not used
End Sub

' DESCRIPTION: This event is fired when a message is deleted from the folder
Public Sub Folder_OnMessageDeleted
 'Not used
End Sub

' DESCRIPTION: This event is fired when the timer on the folder expires
Public Sub Folder_OnTimer
 Dim objSession      ' Session
 Dim objReportMsg     ' Report message
 Dim objFolderOutbox     ' Outbox folder
 Dim objRecipient     ' Recipient
 Dim objUserSess      ' User session
 Dim objRecipientList    ' Recipients address list
 Dim objUserList      ' Address entries of the recipients
 Dim objUser          ' Single user
 Dim objFileSystem     ' Scripting Filesystem object
 Dim objFile          ' File object
 Dim objAttachment     ' Attachment object

 Dim objInfoStores     ' collection of Infostores
 Dim objInfoStore     ' single Infostore
 Dim objTopFolder     ' Top Folder
 Dim objFolders      ' collection of Folders
 Dim objFolder      ' single folder
 Dim objTopSubFolder     ' Top Folder
 Dim objSubFolders     ' collection of Folders
 Dim objSubFolder     ' Sub folder

 Dim intCounter      ' Counter
 Dim strProfileInfo     ' MAPI profile information
 Dim strReportText     ' Report with results
 Dim strUserID      ' Session ID of the user MAPI session
 Dim strUserName      ' Username
 'Dim intUserCount     ' Count of messages
 'Dim intUserUnread     ' Count of unread messages
 Dim intFolderSize     ' Folder size
 'Dim strUserMail      ' E-mail address
 Dim strUserHomeServer    ' Mailbox home server
 Dim strAgentID      ' Session ID of the agent MAPI session
 Dim strAgentHomeServer    ' Agent home server
 Dim strPublicRootID
 Dim strFolderName

 ' Initialize objects
 Set objSession = Nothing
 Set objReportMsg = Nothing
 Set objFolderOutbox = Nothing
 Set objRecipient = Nothing
 Set objUserSess = Nothing
 Set objRecipientList = Nothing
 Set objUserList = Nothing
 Set objUser = Nothing
 Set objFileSystem = Nothing
 Set objFile = Nothing
 Set objAttachment = Nothing
 Set objInfoStores = Nothing
 Set objInfoStore = Nothing
 Set objTopFolder = Nothing
 Set objFolders = Nothing
 Set objFolder = Nothing
 Set objTopSubFolder = Nothing
 Set objSubFolders = Nothing
 Set objSubFolder = Nothing

 ' Set header information of the report textfile in CSV format for use in
conjunction with Microsoft Excel
 strReportText = "Folder Name;Folder Size" & Chr(13)

 ' Clear error buffer
 Err.Clear

 ' Get session informationen
 Set objSession = EventDetails.Session

 ' No errors detected ?
 If Err.Number = 0 Then

  ' Write some logging
  Call DebugAppend(objSession.CurrentUser & " MbxReport - Proccessing
startet", False)

  ' Get session ID of the current logged on MAPI session
  strAgentID = objSession.CurrentUser.ID

  ' Get home MTA property of the current session and extract the home server
  strAgentHomeServer =
objSession.GetAddressEntry(strAgentID).Fields(PR_EMS_AB_HOME_MTA)
  strAgentHomeServer = Mid(strAgentHomeServer, InStr(1, strAgentHomeServer,
"/cn=Configuration/cn=Servers/cn=") +
Len("/cn=Configuration/cn=Servers/cn="),255)
  strAgentHomeServer = Left(strAgentHomeServer, InStr(1, strAgentHomeServer,
"/") -1)

  ' Create MAPI session
  Set objUserSess = Nothing
  On Error Resume Next
  Set objUserSess = CreateObject("MAPI.Session")

  ' No errors detected ?
  If Not objUserSess Is Nothing Then

   ' Logging on with user, write logging
   Call DebugAppend("Logging on with user: " & objUser.Name, False)

   ' Create MAPI profile and logon to the user mailbox
   Err.Clear
   strProfileInfo = strUserHomeServer & Chr(10) &
objUser.Fields.Item(CdoPR_ACCOUNT).Value
   On Error Resume Next
   objUserSess.Logon "", "", False, True, 0, False, strProfileInfo

   ' No errors detected ?
   If Err.Number = 0 Then

    ' Logon successfully, write logging
    Call DebugAppend("Logon successfully with user: " &
objUserSess.CurrentUser, False)

    ' Initialize variables
    intCounter = 1
    intFolderSize = ""
    'STOP
    ' Loop through the infostores
    Set ObjInfoStores = objUserSess.InfoStores
    For intCounter = 1 To objUserSess.InfoStores.Count
    ' Check if we have hit the public information store
    ' Note that the name of the public information store is not language
independent
    ' You must change it to the language of the Exchange Server which you
use
    'If Trim(UCase(objUserSess.Infostores.Item(intCounter).Name)) = "Public
Information StorePublic Information Store" Then
     if objInfoStores.item(intCounter)="Public Information Store" Then
      Set objInfoStore = objInfoStores.item(intCounter)
      Exit for
     end if
    Next
    'find Top folder
    strPublicRootID =
objInfoStore.fields.item(PR_IPM_PUBLIC_FOLDERS_ENTRYID).value
    Set objTopFolder = objUserSess.GetFolder
(strPublicRootID,objInfoStore.ID)
    Set objFolders = objTopFolder.Folders
    For each objFolder in objFolders
     ' Get name of the folder
     strFolderName = objFolder.name
     ' Get size of the Folder
     intFolderSize =
Int((objUserSess.Infostores.Item(intCounter).Fields(CdoPR_FOLDER_SIZE))  /
1024)
     If Trim(intFolderSize) <> "" Then
      intFolderSize = intFolderSize & " Kbytes"
     Else
      intFolderSize = "N/A"
     End If
     ' Create report data, write logging
     Call DebugAppend("Write report data", False)

     ' Add the results to the report text
     strReportText = strReportText & strFolderName & ";" & intFolderSize &
";" & Chr(13)

     'Check if the folder have sub folders
     'if objFolder.item(CdoPR_SUBFOLDERS)= true then
      'Set objTopSubFolder = objUserSess.GetFolder(objFolder.ID)
      'set objSubFolders = objTopSubFolder.Folders

      'fiquei aqui QQQQQQQQQQQQQQQQQQQQQQQQQQQQ

    Next

    ' Close MAPI session, write logging
    Call DebugAppend("Close MAPI session", False)

    ' Logoff from the mailbox
    On Error Resume Next
    objUserSess.Logoff
    Set objUserSess = Nothing
   Else
    ' Could not log on, write logging
    Call DebugAppend("Error - Could not log on on with user: " &
objUser.Name, True)
   End If
  Else
   ' Could not create MAPI session, write logging
   Call DebugAppend("Error - Could not create MAPI session", True)
  End If
  ' Clear error buffer
  Err.Clear
 end if
 ' Check if report is not empty
 If Trim(strReportText) <> "" Then

  ' Get outbox folder
  On Error Resume Next
  Set objFolderOutbox = objSession.Outbox

  ' No errors detected ?
  If Not objFolderOutbox Is Nothing Then
   ' Create Scripting FileSystem object
   On Error Resume Next
   Set objFileSystem = CreateObject("Scripting.FileSystemObject")
   ' No errors detected ?
   If Not objFileSystem Is Nothing Then
    ' Create file, if already exists overwrite it
    On Error Resume Next
    Set objFile = objFileSystem.CreateTextFile(g_Const_ReportFile, True)
    ' No errors detected ?
    If Not objFile Is Nothing Then
     ' Write report to file
     objFile.Write strReportText
     ' Close file
     objFile.Close
    End If
   End If
   ' Create new message
   On Error Resume Next
   Set objReportMsg = objFolderOutbox.Messages.Add
   ' No errors detected ?
   If Not objReportMsg Is Nothing Then
    ' Add attachment to the message
    On Error Resume Next
    Set objAttachment = objReportMsg.Attachments.Add
    ' No errors detected?
    If Not objAttachment Is Nothing Then
     ' Add the report as attachment at the end of the message
     objAttachment.Position = -1
     objAttachment.Type = 1
     objAttachment.Source = g_Const_ReportFile
     objAttachment.ReadFromFile g_Const_ReportFile
    End If
    ' Set subject
    objReportMsg.Subject = "Folder Report created: " & Date
    ' Enter your message text here
    objReportMsg.Text = "Attached is your scheduled Folder report" & Chr(10)
    ' Set recipient
    Set objRecipient = objReportMsg.Recipients.Add
...

read more »

You might want to post this in the microsoft.public.outlook.program_vba group... good
luck.

read more »