Question

我有以下代码＆＃34;自动＆＃34;将Outlook电子邮件下载到特定的本地目录。

我想更具体地说明已保存邮件的文件名。

我需要搜索电子邮件主题和/或正文以AANNNNNNA格式查找一串文本，其中A是字母，N是数字。如果发现在结果文件名中使用该代替主体，如果没有，请使用电子邮件的主题。

我无法弄清楚如何搜索上述格式。

Option Explicit

Public Sub SaveMessageAsMsg()

    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath As String
    Dim dtDate As Date
    Dim sName As String

    For Each objItem In ActiveExplorer.Selection
        If objItem.MessageClass = "IPM.Note" Then

            Set oMail = objItem

            sName = oMail.Subject
            ReplaceCharsForFileName sName, "-"

            dtDate = oMail.ReceivedTime
            sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
              vbUseSystem) & Format(dtDate, "-hhnnss", _
              vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

            sPath = "C:\Users\XXXXXX\Desktop\Test\"
            Debug.Print sPath & sName
            oMail.SaveAs sPath & sName, olMSG

        End If
    Next

End Sub

Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
    sName = Replace(sName, "'", sChr)
    sName = Replace(sName, "*", sChr)
    sName = Replace(sName, "/", sChr)
    sName = Replace(sName, "\", sChr)
    sName = Replace(sName, ":", sChr)
    sName = Replace(sName, "?", sChr)
    sName = Replace(sName, Chr(34), sChr)
    sName = Replace(sName, "<", sChr)
    sName = Replace(sName, ">", sChr)
    sName = Replace(sName, "|", sChr)
End Sub

Answer 1

这是通过简单地解析字符串来实现它的一种方法：

Public Function FindCode(sCode As String) As String
  Dim sCheck As String
  Dim nIndex As Integer
  For nIndex = 1 To Len(sCode) - 8
    sCheck = Mid$(sCode, nIndex, 9)
    If IsNumeric(Mid$(sCheck, 3, 6)) And _
      Not IsNumeric(Mid$(sCheck, 1, 2)) And _
      Not IsNumeric(Mid$(sCheck, 9, 1)) Then
        FindCode = sCheck
        Exit Function
    End If
  Next
  FindCode = "[not found]"
End Function

Answer 2

Regex可能是您的选项（https://docs.microsoft.com/en-us/dotnet/standard/base-types/regular-expression-language-quick-reference），但考虑到搜索模式的简单性，Like运算符似乎是一个明显的选择（https://msdn.microsoft.com/VBA/Language-Reference-VBA/articles/like-operator）。< / p>

Like的唯一缺点是它不会在搜索字符串中返回匹配的位置（它只返回True或False），因此您需要以9个字符的批量迭代你的搜索字符串以找到匹配然后返回它。

Public Sub RunMe()
    Dim str As String
    Dim nme As String


    str = "To whom it may concern, find this: AB123456C. Happy coding, Ambie"
    nme = FindName(str)
    If nme <> "" Then MsgBox nme

End Sub
Private Function FindName(searchText As String) As String
    Const PTRN As String = "[A-Za-z][A-Za-z]######[A-Za-z]"
    Dim txt As String
    Dim i As Long

    If Len(searchText) >= 9 Then
        For i = 1 To Len(searchText) - 9 + 1
            txt = Mid(searchText, i, 9)
            If txt Like PTRN Then
                FindName = txt
                Exit Function
            End If
        Next
    End If

End Function

以特定格式查找字符串

2 个答案: