在Outlook中使用VBA刮取主题行并生成/执行URL

Question

我们有一个内部网站，该网站通过JIRA请求构建MSI软件包，该网站通过url接受GET变量。我想为每封电子邮件附带的主题完成什么：]

JIRA: (V-1244) TEST: Automatic Tool Builder

我想在“ V-”后面抓取数字并将其插入此链接：

https://test.tool/gen.php?v=1244&submitV=Submit

生成链接后，我希望它在浏览器中启动URL。这是可能的，因为我是VBA的新手，只是在寻找方向。我搜索了无数页面，但没有找到所需的东西。

Answer 1

经过一番摸索之后，我终于明白了！这段代码的作用是在应用程序启动时设置一个侦听器，然后其中的任何电子邮件都会在主题中的任何地方检查“ JIRA”，因为主题行始终是静态的，只是4个数字发生了变化，因此我使用[C0将主题分解为数组]。然后，我在数组中查询所需主题的一部分，然后使用SPLIT()提取URL所需的ID。 URL完成后，我会将URL的各个部分连接到一个变量中，该变量输出我需要执行的完整URL。从那里，我使用MID()启动并执行浏览器，那就可以了：D！这里要提到的一件事是，要使此脚本起作用，必须将脚本放置在Microsoft Visual Basic for Applications项目下的CreateObject("Shell.Application")下，当您在Outlook中按下ALT + F11并保存脚本后，必须重新启动Outlook加载。您还必须转到位于文件->选项->信任中心下的信任中心，单击信任中心设置按钮，然后在该菜单下选择“宏设置”，然后将选项设置为“所有宏的通知”这样，它将在Outlook启动时通知您启用宏。引用的代码行是1.我用来向我显示变量输出的msgbox和2.最后，我可以从电子邮件本身查询其他项目。如果他们试图查询传入电子邮件的其他部分，我将其留在这里可能会帮助其他人。

ThisOutlookSession

Answer 2

使用正则表达式

示例

Option Explicit
Private WithEvents inboxItems As Outlook.Items

Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler

Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
Dim vID
Dim vURL1
Dim vURL2
Dim vURL3
Dim fullVID
Dim fullVURL


If TypeName(Item) = "MailItem" And InStr(1, Item.Subject, "JIRA") > 0 Then
Dim s As String: s = Item.Subject

fullVID = Split(s, " ")(2)
vID = Mid(fullVID, 7, 4)
vURL1 = "https://test.tool/gen.php?v="
vURL2 = vID
vURL3 = "&submitV=Submit"
fullVURL = vURL1 & vURL2 & vURL3


    MessageInfo = "" & _
        "Subject : " & Item.Subject & vbCrLf & _
        "Variable 1 : " & Split(s, " ")(0) & vbCrLf & _
        "JIRA V : " & vID & vbCrLf & _
        "Create V URL : " & fullVURL

    'Result = MsgBox(MessageInfo, vbOKOnly, "New JIRA Ticket Received")

Dim build
Set build = CreateObject("Shell.Application")
build.ShellExecute "Chrome.exe", fullVURL, "", "", 1

End If

ExitNewItem:
    Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

'"Message Body : " & vbCrLf & Item.Body
'"Sender : " & Item.SenderEmailAddress & vbCrLf & _
'"Sent : " & Item.SentOn & vbCrLf & _
'"Received : " & Item.ReceivedTime & vbCrLf & _
'"Size : " & Item.Size

\((.*)\)

https://regex101.com/r/b6VPxR/1

VBA