將VBA結果輸出到Outlook 2010中的文本文件

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

以下是你的代碼，轉換成調用函數，傳遞一個字符串，會寫入一個文本文件中。更改文件路徑&名稱以滿足您的需求。

就個人而言，我不喜歡這種調用方法，因爲對於每次調用來說，檢查文件是否存在等都是一種浪費。但是，由於您的代碼有兩個需要編寫文本的子例程，所以我懶得在代碼中嵌入正確的代碼。你可以保持現狀（如果很少使用），或者根據需要組合在一起。

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