VBA_OutLook_代码

Sub Get2FACode()
    Dim objApp As Outlook.Application
    Dim objItem As Object ' MailItem
    Dim myOlItems As Object
    
    Set objApp = Outlook.Application
    
    '获取选中的（或打开的）邮件
'    Set objItem = objApp.ActiveExplorer.Selection.item(1)
'    Call SaveAutoAttach(objItem)
    
    '获取收件箱内最新的邮件
'    Set objNS = objApp.GetNamespace("MAPI")
'    Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
'    Call SaveAutoAttach(myOlItems(myOlItems.Count))
    
    
    '循环遍历收件箱内前3封邮件
    Dim i
    Dim j
    Dim ret
    Set objNS = objApp.GetNamespace("MAPI")
    Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
    For i = 1 To 10
        Application.Wait (Now + TimeValue("0:00:05"))
        For j = myOlItems.Count To (myOlItems.Count - 3) Step -1
            ret = ""
            ret = SaveAutoAttach(myOlItems(j))
            If ret <> "" Then
                Exit For
            End If
        Next j
        If ret <> "" Then
            Exit For
        End If
    Next i
    Debug.Print (ret)
End Sub



Public Function SaveAutoAttach(item As Outlook.MailItem) As String
    Dim regex           As Object
    Dim MatchSet        As Object
    Dim Match2FACode    As String
    
    Match2FACode = ""
    Set regex = CreateObject("vbscript.regexp")
    
    'Find the 2FA passcode   ---  For SAP
'    regEx.Pattern = "2FATokenforlogin\:[a-zA-Z0-9]{6,20}"
'    regEx.Global = True
'
'    source_string = VBA.Replace(item.Body, " ", "")
'    Set MatchSet = regEx.Execute(source_string)
'
'    If MatchSet.Count > 0 Then
'        Match2FACode = Split(MatchSet(0).Value, ":")(1)
'    End If
    
    'Find the 2FA passcode   ---  For IBM internal website
    regex.Pattern = "Yourpasscodeis\:[0-9]{4}-[0-9]{6}"
    regex.Global = True
    
    source_string = VBA.Replace(item.Body, " ", "")
    Set MatchSet = regex.Execute(source_string)
    
    If MatchSet.Count > 0 Then
        Match2FACode = Split(Split(MatchSet(0).Value, ":")(1), "-")(1)
    End If
    
    
    'Debug.Print (Match2FACode)
    SaveAutoAttach = Match2FACode
    
    'Save the 2FA passcode into environment "GV_AC_CODE"
    'Call WriteUserEnv("2FA_CODE", CStr(Match2FACode))

End Function

'Write certain value into environment variable function
Sub WriteUserEnv(in_name As String, in_value As String)
    Dim objUserEnvVars As Object
    Set objUserEnvVars = CreateObject("WScript.Shell").Environment("User")
    objUserEnvVars.item(in_name) = in_value
End Sub



'正则表达式的其他例子：
Sub t3()
    Dim bo As Boolean
    bo = isDightOrLetter("我12sdf", "Asc")
    Debug.Print (bo)
    bo = isDightOrLetter("我12sdf", "Regx")
    Debug.Print (bo)

End Sub

Function isDightOrLetter(in_str As String, in_type As String) As Boolean
    '均在半角下有效
    Dim string1     As String
    string1 = in_str
    
    If in_type = "Asc" Then
        Dim string_all  As String
        Dim string1_arr
        Dim i
        Dim j
 
        string1 = VBA.Replace(string1, " ", "")
        For i = 1 To Len(string1)
            string_all = VBA.Trim(string_all & Mid(string1, i, 1) & "|")
        Next
        
        If Right(string_all, 1) = "|" Then
            string_all = VBA.Left(string_all, Len(string_all) - 1)
        End If
        
        string1_arr = VBA.Split(string_all, "|")
        'Debug.Print (UBound(string1_arr))
        
        For Each j In string1_arr
            'Debug.Print (Asc(j))
            If (Asc(j) >= 48 And Asc(j) <= 57) Or (Asc(j) >= 65 And Asc(j) <= 90) Or (Asc(j) >= 97 And Asc(j) <= 122) Then
                isDightOrLetter = True
            Else
                isDightOrLetter = False
                Exit For
            End If
        Next j
        
    ElseIf in_type = "Regx" Then
        Dim regex As New RegExp
        Dim MatchSet
        Set regex = CreateObject("vbscript.regexp")
        regex.Pattern = "^[0-9A-Za-z]+[0-9A-Za-z]$"
        regex.Global = True
    
        Set MatchSet = regex.Execute(string1)
        
        If MatchSet.Count > 0 Then
            isDightOrLetter = True
        Else
            isDightOrLetter = False
        End If
    End If
    
End Function

标签：Dim,VBA,Set,End,string,代码,OutLook,String,string1
来源： https://www.cnblogs.com/Collin-pxy/p/16416000.html