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

问题描述：

我正在尝试将以下输出转换为我的桌面上的文本文件。我是非常新的（如今天），我在网上找到了下面的脚本，我已经弄清了每个脚本的含义，但是我努力使它作为文本文件输出。我不确定命令应该到哪里（从中间开始或结束？）来执行此操作。我找到了一个命令，但我得到的错误向左和向右。请帮忙。将VBA结果输出到Outlook 2010中的文本文件

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

您发布的代码只是列出了每个文件夹中的项目数量。而且你还没有定义你想要的输出。请帮助我们。 –

@ WayneG.Dunn，OP想要打印到文本文件而不是立即窗口。 – jsotola

要向文件写入您的Debug.Print生成的内容，您可以使用'打开输出...并打印'或文件系统对象文本流...'。目前不在我的个人电脑附近，但明天可以举例说明。大量的样品在线，如果你谷歌：vba写入文本文件 –

答

以下是你的代码，转换成调用函数，传递一个字符串，会写入一个文本文件中。更改文件路径&名称以满足您的需求。

就个人而言，我不喜欢这种调用方法，因为对于每次调用来说，检查文件是否存在等都是一种浪费。但是，由于您的代码有两个需要编写文本的子例程，所以我懒得在代码中嵌入正确的代码。你可以保持现状（如果很少使用），或者根据需要组合在一起。

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中的文本文件

相关推荐