如何在 main sub VBA 中获取函数值

Question

我想在我的主子中获取下面函数的值（正则表达式结果），以便将它添加到我的文件的标题中，我该怎么做？

    Public Sub Process_SAU(Item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment
Dim saveFolder As String

Dim Code as String
Code = ExtractText


' Folder location when I want to save my file
saveFolder = "C:\Users\gdeange1\Desktop\suggestion updates\UpdateBusinessInformation\Processed_By_Bulks"
       For Each object_attachment In Item.Attachments
' Criteria to save .doc files only
    If InStr(object_attachment.DisplayName, ".json") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & Code & "_" & object_attachment.DisplayName

    End If
 
    Next

End Sub

Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match

 regEx.Pattern = "((.*))[A-Z]{0}(Danièle Loubert|Véronique Mantha|Julie-Emmanuelle Carle|Nicolas Bertrand|Martine Jean)"

 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = "Blabla"
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
    Code = ExtractText
 End Function

我上面试过的代码没有用。

感谢您的帮助！

Answer 1

您可能已经复制了函数 ExtractText(Str As String) ，但此函数需要在使用此函数时传递一个字符串值，而您没有这样做。如果您在主代码中使用该函数时传递字符串类型值，它应该可以工作。

Answer 2

您将 Item 传递给 Public Sub Process_SAU(Item As MailItem)。

同样，你必须将Str传递给Function ExtractText(Str As String) As String。

Option Explicit 

Private Sub test_Process_SAU()

    Dim currItem As Object
    
    ' with a selected item
    Set currItem = ActiveExplorer.Selection(1)
    
    ' or
    
    ' with an open item
    'Set currItem = ActiveInspector.currentItem
    
    If currItem.Class = olMail Then
        Process_SAU currItem
    End If
    
End Sub


Public Sub Process_SAU(Item As MailItem)

    Dim Code As String
    
    ' Pass the applicable string to the function
    Code = ExtractText(Item.body)
    Debug.Print " Code: " & Code
    
    Dim object_attachment As outlook.Attachment
    Dim saveFolder As String

    saveFolder = "C:\Users\gdeange1\Desktop\suggestion updates\UpdateBusinessInformation\Processed_By_Bulks"
    
    For Each object_attachment In Item.Attachments
        
        If InStr(object_attachment.DisplayName, ".json") Then
 
            object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & Code & "_" & object_attachment.DisplayName
            
        End If
 
    Next

End Sub


Function ExtractText(Str As String) As String

    Dim regEx As New regExp
    Dim NumMatches As MatchCollection
    Dim M As Match
    
    regEx.Pattern = "((.*))[A-Z]{0}(Danièle Loubert|Véronique Mantha|Julie-Emmanuelle Carle|Nicolas Bertrand|Martine Jean)"
    
    Set NumMatches = regEx.Execute(Str)
    If NumMatches.count = 0 Then
        ExtractText = "Blabla"
    Else
        Set M = NumMatches(0)
        ExtractText = M.Value
    End If
    
End Function

如何在 main sub VBA 中获取函数值

How to get function value in main sub VBA

outlook

vba