Question

我想在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

Answer 1

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

在Set wdApp = GetObject(, "Excel.Application")中，wdApp是为Word应用程序提供的一种名称。我的猜测是，您找到了一些使用Word进行处理并对其进行修改的代码。 Set wdDoc = wdApp.Documents.Open(strFilename)对Excel应用程序无效。我建议使用名称xlApp。打开工作簿，必须为Excel重写搜索代码。
您没有包含FolderExists和CreateFolders的代码，但是如果他们不使用FileSystemObject，我会感到惊讶。 FileSystemObject和Outlook的数据类型均为Folder。如果所有这些代码都在Outlook中，则Folder被解释为Outlook.Folder，并且FolderExists和CreateFolders可能不起作用。如有必要，您需要在这些例程中将数据类型Folder替换为Scripting.Folder。
Set olItems = Session.GetDefaultFolder(olFolderInbox).Items在我的系统上不起作用。我是家庭用户，有两个电子邮件地址，每个电子邮件地址都有自己的商店和收件箱。未使用默认的收件箱。如果您是具有单个电子邮件地址的公司用户，那么您的默认收件箱可能就是您想要的收件箱。
您写道：“如果存在该“字符串”，我希望邮件移至另一个文件夹。”我解释这表示您希望将Outlook MailItem移至其他Outlook文件夹。这就是为什么我批评您使用Name来重命名光盘文件或将其移动到具有新名称（可选）的其他光盘文件夹中的原因。我现在想知道您是否要移动保存的附件。
此答案此处需要一个段落，说明如何移动MailItem或移动所需的附件。请在此答案中添加评论，以解释您想要的内容。
在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”或其他一些临时文件夹？
请小心分隔文件夹和文件名。您使用Chr(32)和Chr(92)。我认为Chr(32)是一个错误。为什么不写“ \”而不是Chr(92)呢？我在必要时使用Chr()，但通常写起来更清晰。使用File Explorer的任何人都将知道“ \”，但是有多少人知道Chr(92)却没有查找。
我不明白您为保存的附件提供的复杂文件名。如果希望将附件移动到其他名称不同的文件夹中。如果不需要附件，则应使用Kill将其删除。两种方式都简单一些。只需固定文件名。
您知道如何在工作簿中搜索特定字符串吗？您现有的所有代码都用于打开和搜索Word文档。

我已经对段落进行了编号，以便在需要提问时可以方便地引用它们。

搜索附件中的文本

1 个答案: