|
斑竹：能否讲解以下代码的作用？
Option Explicit
' MatroExpungeIMAP
' code by Matro
' rome, italy, 2004
' matro@email.it
'
' this code may be used in compiled form in any way you desire. this
' file may be redistributed unmodified by any means PROVIDING it is
' not sold for profit without the authors written consent, and
' providing that this notice and the authors name is included. If
' the source code in this file is used in any commercial application
' then acknowledgement must be made to the author of this file
' (in whatever form you wish).
'
' this file is provided "as is" with no expressed or implied warranty.
' the author accepts no liability for any damage caused through use.
'
' important: expect bugs.
'
' use and enjoy. :-)
Const MATROEXPUNGEIMAP_RELEASE = "004"
Const MATROEXPUNGEIMAP_CLICKYESMLS = 2000
Const TemporaryFolder = 2
Public Sub MatroExpungeIMAP()
Dim appOutlook, nsMapi, barEdit, btnPurge, rootFolder, btnConnect
Dim ClickYesPath As String
Set appOutlook = CreateObject("Outlook.Application")
Set nsMapi = appOutlook.GetNamespace("MAPI")
' the macro is all here: it selects the Expunge button...
Set barEdit = ActiveExplorer.CommandBars("Edit")
Set btnPurge = barEdit.FindControl(msoControlButton, 5583, , , True)
Set barEdit = ActiveExplorer.CommandBars("File")
Set btnConnect = barEdit.FindControl(msoControlButton, 9441, , , True)
If btnPurge Is Nothing Or btnConnect Is Nothing Then
MsgBox "Select a valid IMAP folder once at least, then run this macro again.", vbInformation, "MatroExpungeIMAP"
Exit Sub
End If
If nsMapi.Offline Then
MsgBox "Go Online, then run this macro again.", vbInformation, "MatroExpungeIMAP"
Exit Sub
End If
' ...and it selects the 'Yes' button in the confirm dialog...
ClickYesPath = ExpungeCreateClickYesScript()
' ...on each IMAP folder, recursively...
For Each rootFolder In nsMapi.Folders()
Call ExpungeCurrentFolder(nsMapi.Folders(rootFolder.Name), btnPurge, btnConnect, ClickYesPath)
Next
' ...then it sits back on its window...
Set ActiveExplorer.currentFolder = nsMapi.GetDefaultFolder(olFolderInbox)
' ...and that's all madams and sirs. :-)
End Sub
Private Sub ExpungeCurrentFolder(parentFolders, btnPurge, btnConnect, ClickYesPath As String)
Dim currentFolder
For Each currentFolder In parentFolders.Folders
Call ExpungeCurrentFolder(currentFolder, btnPurge, btnConnect, ClickYesPath)
DoEvents
If currentFolder.DefaultItemType = olMailItem And Not btnConnect.Enabled Then
Set ActiveExplorer.currentFolder = currentFolder
If btnPurge.Visible Then
If Len(ClickYesPath) > 0 Then
Call Shell("wscript " & ClickYesPath, vbHide)
End If
btnPurge.Execute
End If
End If
Next
End Sub
Private Function ExpungeCreateClickYesScript() As String
Dim fs, f
' basically, the auto click yes feature works by creating a VBScript routine
' which will be called asynchronously on a separate process.
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
ExpungeCreateClickYesScript = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), "MatroExpungeClickYes.vbs")
Set f = fs.CreateTextFile(ExpungeCreateClickYesScript, True)
f.WriteLine ("' this is part of MatroExpungeIMAP rel" & MATROEXPUNGEIMAP_RELEASE)
f.WriteLine ("' MatroExpungeIMAP is an opensource macro for MS Outlook.")
f.WriteLine ("'")
f.WriteLine ("set sh=WScript.CreateObject(""WScript.Shell"")" & vbCrLf & "WScript.Sleep(" & (MATROEXPUNGEIMAP_CLICKYESMLS / 2) & ")")
f.WriteLine ("activated = False: dt = 100: tw = " & MATROEXPUNGEIMAP_CLICKYESMLS)
f.WriteLine ("Do While (Not activated And tw > 0)" & vbCrLf & "activated = sh.AppActivate(""Microsoft Office Outlook"")" & vbCrLf & "WScript.Sleep (dt): tw = tw - dt" & vbCrLf & "Loop")
f.WriteLine ("If tw >= dt Then" & vbCrLf & "WScript.Sleep(dt): sh.SendKeys(""{TAB 2}{ENTER}"")" & vbCrLf & "End If")
f.Close
Set fs = Nothing
If Err <> 0 Then ExpungeCreateClickYesScript = ""
End Function | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-7-28 17:15
