P

'

' vbs - Microsoft Outlook Exchange 2000

' elenca tutte le cartelle pubbliche

'

'

Option Explicit

'

dim NomeArchivio, cosascrivere

NomeArchivio="C:\elenco-cartelle-exchange.txt" '

'

call cancellazioneiniziale(NomeArchivio)

'

call ElencaCartellePubbliche

' ===============

sub ElencaCartellePubbliche()

Dim objFolder, objNamespace, objOutlook

'

Const TipoCartella = 18 ' cartelle pubbliche ' 5 = Sent Items

'

Set objOutlook = CreateObject( "Outlook.Application" )

Set objNamespace = objOutlook.GetNamespace( "MAPI" )

'

objNamespace.Logon "Default Outlook Profile", , False, False

Set objFolder = objNamespace.GetDefaultFolder( TipoCartella )

'

Dim scartelle

'

for each scartelle in objFolder.folders

'msgbox scartelle.Name

cosascrivere = scartelle.Name

Call ScriviFileJollyAppend(NomeArchivio, cosascrivere)

next

'

Set objOutlook = Nothing

Set objNamespace = Nothing

Set objFolder = Nothing

'

End sub

' =====

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

' ===

sub cancellazioneiniziale(vNomeArchivio)

dim CFSO

Set CFSO = CreateObject("Scripting.FileSystemObject")

If CFSO.FileExists(vNomeArchivio) = true Then

CFSO.DeleteFile(vNomeArchivio)

else

end if

end sub

'=========