[英]Can i add number of emails beside Folder name using this vba macro in Outlook 2013?
我有這個宏來打印選定 Outlook 文件夾的文件夾樹,但我需要在每個文件夾名稱旁邊添加電子郵件數量(每個文件夾分別不包括子文件夾):
Dim MyFile, Structured, Base
Call ExportFolderNamesSelect()
Public Sub ExportFolderNamesSelect()
Dim objOutlook
Set objOutlook = CreateObject("Outlook.Application")
Dim F, Folders
Set F = objOutlook.Session.PickFolder
If Not F Is Nothing Then
Set Folders = F.Folders
Dim Result
Result = MsgBox("Do you want to structure the output?", vbYesNo+vbDefaultButton2+vbApplicationModal, "Output structuring")
If Result = 6 Then
Structured = True
Else
Structured = False
End If
MyFile = GetDesktopFolder() & "\outlookfolders.txt"
Base = Len(F.FolderPath) - Len(Replace(F.FolderPath, "\", "")) + 1
WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name))
LoopFolders Folders
Set F = Nothing
Set Folders = Nothing
Set objOutlook = Nothing
End If
End Sub
Private Function GetDesktopFolder()
Dim objShell
Set objShell = CreateObject("WScript.Shell")
GetDesktopFolder = objShell.SpecialFolders("Desktop")
Set objShell = Nothing
End Function
Private Sub LoopFolders(Folders)
Dim F
For Each F In Folders
WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name))
LoopFolders F.Folders
Next
End Sub
Private Sub WriteToATextFile(OLKfoldername)
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (MyFile, 8, True)
objTextFile.WriteLine (OLKfoldername)
objTextFile.Close
Set objFSO = Nothing
Set objTextFile = Nothing
End Sub
Private Function StructuredFolderName(OLKfolderpath, OLKfoldername)
If Structured = False Then
StructuredFolderName = Mid(OLKfolderpath, 3)
Else
Dim i, x, OLKprefix
i = Len(OLKfolderpath) - Len(Replace(OLKfolderpath, "\", ""))
For x = Base To i
OLKprefix = OLKprefix & "-"
Next
StructuredFolderName = OLKprefix & OLKfoldername
End If
End Function
你能幫我嗎?
我找到了解決方案,將.Items.Count添加到文件夾名稱,如下所示:
Dim MyFile, Structured, Base
Call ExportFolderNamesSelect()
Public Sub ExportFolderNamesSelect()
Dim objOutlook
Set objOutlook = CreateObject("Outlook.Application")
Dim F, Folders
Set F = objOutlook.Session.PickFolder
If Not F Is Nothing Then
Set Folders = F.Folders
Dim Result
Result = MsgBox("Do you want to structure the output?", vbYesNo+vbDefaultButton2+vbApplicationModal, "Output structuring")
If Result = 6 Then
Structured = True
Else
Structured = False
End If
MyFile = GetDesktopFolder() & "\outlookfolders.txt"
Base = Len(F.FolderPath) - Len(Replace(F.FolderPath, "\", "")) + 1
WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name) & " " & F.Items.Count)
LoopFolders Folders
Set F = Nothing
Set Folders = Nothing
Set objOutlook = Nothing
End If
End Sub
Private Function GetDesktopFolder()
Dim objShell
Set objShell = CreateObject("WScript.Shell")
GetDesktopFolder = objShell.SpecialFolders("Desktop")
Set objShell = Nothing
End Function
Private Sub LoopFolders(Folders)
Dim F
For Each F In Folders
WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name) & " " & F.Items.Count)
LoopFolders F.Folders
Next
End Sub
Private Sub WriteToATextFile(OLKfoldername)
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (MyFile, 8, True)
objTextFile.WriteLine (OLKfoldername)
objTextFile.Close
Set objFSO = Nothing
Set objTextFile = Nothing
End Sub
Private Function StructuredFolderName(OLKfolderpath, OLKfoldername)
If Structured = False Then
StructuredFolderName = Mid(OLKfolderpath, 3)
Else
Dim i, x, OLKprefix
i = Len(OLKfolderpath) - Len(Replace(OLKfolderpath, "\", ""))
For x = Base To i
OLKprefix = OLKprefix & "-"
Next
StructuredFolderName = OLKprefix & OLKfoldername
End If
End Function
謝謝你幫我...
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.