Question

我已编译此规则触发的脚本，以在电子邮件 (DCSXXXX) （在Outlook中使用VBA）中查找参考号并保存此电子邮件在具有相同名称的文件夹中。

但是，如果文件夹名称为 "DCSXXX [any text]" ，我试图找到一种方法让脚本工作，这意味着我只有一个开头要使用的文件夹名称。有什么想法吗？

Public Sub GetValueUsingRegEx(myItem As MailItem)
' Set reference to VB Script library
' Microsoft VBScript Regular Expressions 5.5

    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim colMatches As matchCollection
    Dim M1 As Match
    Dim Path As String
    Dim enviro As String
    Dim Match As String

    Path = "X:\Path"

    Set olMail = myItem

    Set Reg1 = New RegExp

    Reg1.IgnoreCase = True
    Reg1.Pattern = "DCS\d\d\d\d\d?"
    Reg1.Global = False

    If Reg1.test(olMail.Body) Then

        Set colMatches = Reg1.Execute(olMail.Body)
        Match = Reg1.Execute(olMail.Body)(0)

        For Each M1 In colMatches
            MsgBox (M1)
        Next

    End If

    Subject = olMail.Subject
    Subject = Replace(Subject, ":", "_")
    fullPath = (Path & "" & Match & "" & Subject & ".msg")

    olMail.SaveAs (fullPath)
    MsgBox fullPath
    MsgBox Match
    MsgBox Subject
    MsgBox ("Done")

End Sub

Answer 1

如果我理解正确，你想剥掉多余的文字？你可以像这样使用Split功能：

Subject = olMail.Subject
Subject = Replace(Subject, ":", "_")
Subject = Split(Subject, " ")(0)

那应该只给你DCSXXX部分。

Split函数使用Array返回Delimiter，在本例中为空格字符。在(0)之后直接添加String会使Array返回Subject = Split(Replace(olMail.Subject, ":", "_"), " ")(0)

中的第一项

你也可以将它简化为这样一行：

Split

但是考虑到这一点，因为Replace会消除第一个空格之后的所有内容，因此可能无需使用:将_更改为{{1} ...... ....对吧？

Subject = Split(olMail.Subject, " ")(0)

Answer 2

在保存之前获取完整路径，以下是使用Dir Function

的简单示例

        Dim Path As String
            Path = "X:\Path\"

        Dim FldrName As String
            FldrName = Match

            On Error Resume Next
            Dim sGetPath As String
            sGetPath = Path & Match & "*"

            FldrName = Dir(sGetPath, vbDirectory)

        Dim SavePath As String
            SavePath = Path & FldrName & "\"

或使用功能 - 完整示例

Option Explicit
Public Sub Example(Item As Outlook.mailitem)
    Dim Email As Outlook.mailitem
    Dim Matches As Variant
    Dim RegExp As New RegExp
    Dim Pattern As String

    If TypeOf Item Is Outlook.mailitem Then
        Pattern = "DCS\d\d\d\d\d?"
        With RegExp
            .Global = False
            .Pattern = Pattern
            .IgnoreCase = True
             Set Matches = .Execute(Item.Body)
        End With

        If Matches.Count > 0 Then
            Debug.Print Item.Subject ' Print on Immediate Window
            Debug.Print Matches(0)

            Dim Subject As String
                Subject = Item.Subject
                Subject = Replace(Subject, ":", "_")

            Dim Path As String
                Path = "C:\Temp\"

            Dim FldrName As String
                FldrName = Matches(0)

            Dim SavePath As String
                SavePath = FullPath(FldrName, Path)

                Debug.Print SavePath

            Item.SaveAs SavePath & Subject & ".msg", olMsg

        End If
    End If

    Set RegExp = Nothing
    Set Matches = Nothing
    Set Email = Nothing
    Set Item = Nothing
End Sub

Private Function FullPath(ByVal FldrName As String, _
                                 ByVal Path As String)
    Dim sGetPath As String

    On Error Resume Next
    sGetPath = Path & FldrName & "*"

    Debug.Print sGetPath

    FldrName = Dir(sGetPath, vbDirectory)

    Do While Len(FldrName) > 0
        If Left(FldrName, 1) <> "" Then
            If (GetAttr(FldrName) And vbDirectory) = vbDirectory Then
                Debug.Print FldrName
                FullPath = Path & FldrName & "\"
                Debug.Print FullPath
                Exit Do
            End If
        End If
        FldrName = Dir
    Loop

    If FullPath = Empty Then MsgBox "Folder Not Found"

End Function

仅使用文件夹名称的开头自动保存电子邮件

2 个答案: