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



Function getAllMails()
    Dim outlookItem As Object
    'Dim outlookMail As MailItem
    'Dim outlookFldr As Folder
    'Dim outlookName As Namespace
    'Dim oLoolAtt As Attachment
    Dim oLoolAtt
    Dim outlookName
    Dim outlookMail
    Dim outlookFldr
    
    
    Set outlookName = Application.GetNamespace("MAPI")
    Set outlookFldr = outlookName.GetDefaultFolder(olFolderInbox)
    
    i = 1
    For Each outlookItem In outlookFldr.Items
        Debug.Print ("第" & i & "封邮件：")
        Debug.Print ("主题是：" & outlookItem.Subject)
        Debug.Print ("发件人邮箱是：" & outlookItem.SenderEmailAddress)
        Debug.Print ("邮件正文是：" & outlookItem.Body)
        Debug.Print ("收件时间是：" & outlookItem.ReceivedTime)

        Debug.Print (Chr(10))
        
        i = i + 1
    Next

End Function