我收到来自共享Outlook邮箱的电子邮件中的作业。
在典型的电子邮件中,有多个有关客户的字符串和变量,包括它们的名称,日期和带有连字符的ID,我也想摆脱这些变量。
有两种类型的ID。两者都由8个数字和一个连字符组成,例如1234567-8和123456-78。有时数字前面会有一个字符,因此我认为必须将数据存储在字符串中。我想为每种类型的数据制作宏的多个副本。我希望所有内容都采用简单的字符串形式,因为我想将其复制到剪贴板并粘贴到其他位置,而无需进一步处理。
下面的代码可以满足我的所有需求,除了它将数据存储在变量而不是字符串中并且不会删除连字符。
代码由vbaexpress的gmayor提供。
Option Explicit
Sub GetCustomer()
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim dCust As DataObject
Dim wdDoc As Object
Dim oRng As Object
Dim sCustomer As String
Dim bFound As Boolean
On Error GoTo lbl_Exit
Set olItem = ActiveExplorer.Selection.Item(1)
With olItem
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(findText:="Customer #:[ 0-9]{2,}", MatchWildcards:=True)
sCustomer = Trim(Split(oRng.Text, Chr(58))(1))
bFound = True
Set dCust = New DataObject
dCust.SetText sCustomer
dCust.PutInClipboard
MsgBox "Customer number '" & sCustomer & "' copied to clipboard"
Exit Do
Loop
End With
If Not bFound Then MsgBox "Customer number not found"
End With
lbl_Exit:
Set olItem = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set dCust = Nothing
Exit Sub
End Sub
我想搜索当前预览的电子邮件(如果可能的话),而无需在另一个单独的窗口中打开它,例如
"Customer ID: 123456-78"
并通过简单地删除连字符而不考虑第一部分来重新格式化最后一部分
"Customer ID: "
(客户ID和号码之间有一个很大的空格)。
我也想将日期从2019年11月22日重新格式化为2019年22月11日,并将其复制到剪贴板中。
答案 0 :(得分:1)
基于通配符的搜索仅限于通配符可以提供的内容,这总比没有好,但仍然不是很多。
Outlook为此使用了Word函数,因此VBA documentation for Word适用。在选中“使用通配符”之后,可以使用“查找”对话框中的“特殊”按钮(在Outlook中为F4)查看适用的通配符本身。
据我所知,通配符搜索中没有“可选”部分的概念,这意味着您需要尝试多个通配符模式来解决“有时前面有一个字母”的情况。
因此,根据这些知识和您的示例代码,一般的方法将是
MailItem
中选择当前选择的ActiveExplorer
这样,可以定义多个模式,如果第一个匹配为假阳性,您就有机会继续下一个匹配。
我发现模式[0-9-]{8;9}
和MatchWholeWord
可以很好地工作(数字和破折号,长度在8或9个字符之间),但是现实生活中的数据常常令人惊讶。您可能需要添加更多模式。注意:对我而言,Outlook希望使用;
而不是,
。我不确定这可能取决于系统区域设置。
我也不喜欢“沉默的” On Error Resume
。如果有错误,我希望看到一条错误的实际消息。如果存在可以检查以防止错误的条件,则我希望显式检查此条件。这使代码更健壮,调试也更容易。因此,我的Sub
不包含On Error
行。
在代码中,如下所示:
Sub GetCustomer()
Dim olItem As Outlook.MailItem
Dim oRng As Object
Dim sCustomer As String
Dim patterns As Variant, pattern As Variant
Dim answer As VbMsgBoxResult
' bail out if the preconditions are not right
If ActiveExplorer.Selection.Count = 0 Then Exit Sub
If Not (TypeOf ActiveExplorer.Selection.item(1) Is MailItem) Then Exit Sub
Set olItem = ActiveExplorer.Selection.item(1)
Set oRng = olItem.GetInspector.WordEditor.Range
' add more wildcard patterns in descending order of likelyhood
patterns = Array("[0-9-]{8;9}", "[A-Z][0-9-]{8;9}")
For Each pattern In patterns
oRng.WholeStory
While oRng.Find.Execute(findText:=pattern, MatchWildcards:=True, MatchWholeWord:=True)
answer = MsgBox(oRng.Text, vbYesNoCancel + vbQuestion, "Customer Number")
If answer = vbYes Then
With New DataObject
.SetText oRng.Text
.PutInClipboard
End With
Exit For
ElseIf answer = vbCancel Then
Exit For
End If
Wend
Next pattern
End Sub
在函数末尾将变量设置为Nothing
是多余的。