时间戳

首页 > 解决方案 > 在附件中搜索文本

vba - 在附件中搜索文本

问题描述

我想在 Outlook 收件箱文件夹的附件中搜索“string = my_string”。如果这个“字符串”存在，我希望邮件移动到另一个文件夹。我找到了一个代码，我试图改进它，但它仍然无法正常工作。任何帮助将非常感激。

编辑 这是代码：

 Sub test2()
 Const strFindText As String = "Completed"
 Const strFileType As String = "xlsx|xls"
 Const strPath As String = "C:\Users\PC2\Documents\Georg\Attachment\"
Dim vFileType As Variant
 Dim strFilename As String
 Dim strName As String
 Dim olItems As Outlook.Items
 Dim olItem As Outlook.MailItem
 Dim wb As Object
 Dim xlApp As Object
 Dim olAttach As Outlook.Attachment
 Dim strFolder As String
 Dim bStarted As Boolean
 Dim bFound As Boolean
 Dim i As Long, i_V As Long
Dim fdObj As FileSystemObject
    Set fdObj = CreateObject("Scripting.FileSystemObject")

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
        bStarted = True
    End If
    On Error GoTo 0
    xlApp.Visible = True

If Not fdObj.FolderExists(strPath & strFindText) 
 Then fdObj.CreateFolder strPath & strFindText
End If

Set olItems = Session.GetDefaultFolder(olFolderInbox).Items
For i = olItems.Count To 1 Step -1
   Set olItem = olItems(i)
   If olItem.Attachments.Count > 0 Then
   vFileType = Split(strFileType, "|")
   For Each olAttach In olItem.Attachments
   For i_V = 0 To UBound(vFileType)
   If Right(LCase(olAttach.FileName), Len(vFileType(i_V))) = vFileType(i_V)
 Then strFilename = strPath & 
 Format(olItem.ReceivedTime, "yyyymmdd-HHMMSS") & _" " & olAttach.FileNameolAttach.SaveAsFile strFilename

    Set wb = xlApp.Workbooks.Open(strFilename)
    With xlApp.Find(strFilename, xlValues, xlWhole)
        bFound = False
    Do While .Find(strFindText).Activate    '<-I have problem here
        bFound = True
    Loop
    strName = wb.Name
    wb.Close 0
        If bFound Then
        Name strFilename As strPath & strFindText & "\" & strName
        End If
    End With
End If
Next i_V
Next olAttach
End If

Next i
    If bStarted Then xl.App.Quit
    Set wb = Nothing
    Set xlApp = Nothing
    Set olItem = Nothing
    Set olItems = Nothing
End Sub

标签： vbaoutlook

解决方案

我快速浏览了您的代码并注意到一个错误，因此在评论中报告了它。然后我注意到另一个错误以及我在评论中报告的另一个错误。只有在发布评论之后，我才想知道我的评论对这段代码的作者有多大意义。这个答案是评论的放大版本。它应该可以帮助您改进代码，但是缺少太多内容，无法提供完整的答案。

  1. 在Set wdApp = GetObject(, "Excel.Application")中，wdApp是赋予 Word 应用程序的名称。我的猜测是你找到了一些使用 Word 做某事的代码并对其进行了调整。 Set wdDoc = wdApp.Documents.Open(strFilename)对于 Excel 应用程序无效。我建议使用名称xlApp。工作簿打开，搜索代码必须为 Excel 重写。

  2. 你不包括代码FolderExists，CreateFolders但如果他们不使用，我会感到惊讶FileSystemObject。两者FileSystemObject都有Outlook一个数据类型Folder。如果所有这些代码都在 Outlook 中，则被Folder解释为Outlook.Folder并且可能不起作用。如有必要，您需要将这些例程中的数据类型替换为.FolderExistsCreateFoldersFolderScripting.Folder

  3. Set olItems = Session.GetDefaultFolder(olFolderInbox).Items在我的系统上不起作用。我是一个家庭用户，有两个电子邮件地址，每个地址都有自己的商店和收件箱。不使用默认收件箱。如果您是只有一个电子邮件地址的企业用户，那么您的默认收件箱可能就是您想要的收件箱。

  4. 你写道：“如果这个“字符串”存在，我希望邮件移动到另一个文件夹。” 我将此解释为您希望将 Outlook 移动MailItem到不同的 Outlook 文件夹。这就是为什么我批评你使用Namewhich 重命名光盘文件或将其移动到不同的光盘文件夹，可选的新名称。我现在想知道您的意思是要移动已保存的附件。

  5. 这个答案需要一个段落来解释如何移动MailItem或移动保存的附件，无论它是你想要的。请在此答案中添加评论，说明您想要什么。

  6. 在Const strPath As String = " my_root "中，我很欣赏“my_root”只是一个占位符，因此您不必透露可能是机密的内容。让我们假设真正的值是“C:\Users\Georg\Documents”。如果这是真的，您正在创建“C:\Users\Georg\Documentsmy_string”的路径。如果真值为“​​C:\Users\Georg\Documents\”，则您正在创建“C:\Users\Georg\Documents\my_string”路径。无论哪种方式，您都假设“my_string”的真实值不包含文件夹名称中的无效字符。我不明白为什么您需要文件夹名称来包含搜索字符串。这只是一个用于测试附件的临时文件夹。为什么不将其命名为“C:\Users\Georg\Documents\SavedAttachments”或其他一些临时文件夹？

  7. 请小心分隔文件夹和文件名。您使用Chr(32)和Chr(92)。我认为Chr(32)是一个错误。为什么不写“\”而不是Chr(92)更清楚呢？我Chr()在必要时使用，但通常写的字符更清晰。任何使用过文件资源管理器的人都会知道“\”，但有多少人Chr(92)不查找就知道它的含义。

  8. 我不明白您为保存的附件提供的复杂文件名。如果要将附件移动到具有不同名称的不同文件夹中。如果不需要附件，您应该使用 删除它Kill。无论哪种方式都简单一些。固定文件名就是您所需要的。

  9. 您知道如何在工作簿中搜索特定字符串吗？您现有的所有代码都用于打开和搜索 Word 文档。

我已经对我的段落进行了编号，因此如果您需要提出问题，您可以轻松地参考它们。

推荐阅读