Question

我正在尝试将以下输出转换为桌面上的文本文件。我很新（就像今天一样），我在网上找到了下面的脚本，我已经了解了每个但是我确实努力将它作为文本文件输出。我不确定命令应该去哪里（从中间开始或结束？）来做到这一点。我找到了一个命令但是我得到的错误是左右中心。请帮忙。

Sub CountItemsInMBX()

Dim outapp As Outlook.Application
Set outapp = CreateObject("Outlook.Application")
Dim olns As Outlook.NameSpace
Set olns = outapp.GetNamespace("MAPI")


Debug.Print GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)

End Sub

Function GetSubFolderCount(objParentFolder As MAPIFolder) As Long
Dim currentFolders As Folders
Dim fldCurrent As MAPIFolder


Set currentFolders = objParentFolder.Folders
If currentFolders.Count > 0 Then

Set fldCurrent = currentFolders.GetFirst
While Not fldCurrent Is Nothing
TempFolderCount = TempFolderCount + GetSubFolderCount(fldCurrent)
Set fldCurrent = currentFolders.GetNext
Wend
Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = TempFolderCount + objParentFolder.Items.Count
Else
Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = objParentFolder.Items.Count

End If

End Function

Answer 1

以下是您的代码，转换为调用函数，向其传递一个字符串，该字符串将写入文本文件。更改文件路径＆amp;名称，以满足您的需求。

就个人而言，我不喜欢呼叫方法，因为每次呼叫检查文件是否存在都是浪费。但是，由于您的代码有两个需要编写文本的子程序，我太懒了，无法在代码中嵌入正确的代码。你可以保持原样（如果很少使用），或者如果需要可以组合在一起。

Option Explicit

Sub CountItemsInMBX()
Dim outapp  As Outlook.Application
Dim olns    As Outlook.NameSpace

    Set outapp = CreateObject("Outlook.Application")
    Set olns = outapp.GetNamespace("MAPI")

    'Debug.Print GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)
    Write_To_MyLog GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)
End Sub

Function GetSubFolderCount(objParentFolder As MAPIFolder) As Long
Dim currentFolders  As Folders
Dim fldCurrent      As MAPIFolder
Dim TempFolderCount As Integer

    Set currentFolders = objParentFolder.Folders
    If currentFolders.Count > 0 Then

        Set fldCurrent = currentFolders.GetFirst
        While Not fldCurrent Is Nothing
            TempFolderCount = TempFolderCount + GetSubFolderCount(fldCurrent)
            Set fldCurrent = currentFolders.GetNext
        Wend
        'Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
        Write_To_MyLog objParentFolder.Name & " - " & objParentFolder.Items.Count
        GetSubFolderCount = TempFolderCount + objParentFolder.Items.Count
    Else
        'Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
        Write_To_MyLog objParentFolder.Name & " - " & objParentFolder.Items.Count
        GetSubFolderCount = objParentFolder.Items.Count

    End If

End Function

Public Function Write_To_MyLog(sText As String)
Dim oFSO        As FileSystemObject
Dim oFile       As File
Dim oStream     As TextStream

    On Error GoTo Error_trap

    Set oFSO = New FileSystemObject

    If Not oFSO.FileExists("C:\Temp\Outlook_Folders.txt") Then
        Set oStream = oFSO.CreateTextFile("C:\Temp\Outlook_Folders.txt")
        oStream.WriteLine " "
    Else
        Set oFile = oFSO.GetFile("C:\Temp\Outlook_Folders.txt")
        Set oStream = oFile.OpenAsTextStream(ForAppending, TristateMixed)
    End If

    oStream.WriteLine sText
    oStream.Close
    Set oStream = Nothing
    Set oFile = Nothing
    Set oFSO = Nothing

Early_Exit:
    Exit Function

Error_trap:
Dim strError    As String

    strError = "In subroutine: Write_To_MyLog " & vbCrLf & _
                Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & _
                        "At Line: " & Erl
    Err.Source = "Module_Utilities: Write_To_MyLog  at Line: " & Erl
    MsgBox "Error: " & strError
    'Write_To_Log strError   ' This is a call to a function that saves the error info to a database table.
    Resume Early_Exit
    Resume Next
End Function

将VBA结果输出到Outlook 2010中的文本文件

1 个答案: