2015-03-31 62 views
0

我需要从同一行中提取地址和潜在的邮政编码作为单独的实体。地址行可能包含或不包含邮政编码,可能包含或不包含其他不需要的字符串。这是由于Web表单中存在一个错误,该错误是固定的,但已经对一组元素造成了损害。VBA和RegEx与Excel 2010中的任意字符串匹配

可能形式和结果:

  • 地址:有的地址251,99302东西电话:555 6798 8473 - 回归 “的一些地址251” 和 “99302东西” 在单独的字符串。逗号可能会或可能不会被空白尾随。
  • 地址:部分地址251 - 返回“部分地址251”
  • 地址:部分地址251,99302 - 返回“部分地址251”和“99302”。再次,逗号可能会或可能不会被空白尾随。

我这如何可以编程在VBA通过遍历字符串并检查单个字符和字符串做一个基本的了解,但我觉得这将是耗时的,不是很健壮之后。或者如果它强大的话,它会因为所有可能的变化而变得巨大。

我正在为如何形成正则表达式和可能的条件以获得理想的结果而苦苦挣扎。

这是一个较大的项目的一部分,所以我不会粘贴所有的各种代码,但我从Outlook拉邮件来分析和转储相关信息到Excel工作表。我的Outlook和Excel代码都有效,但提取信息的逻辑有点不妥。

下面是新片段我一直在努力:

Function regexp(str As String, regP As String) 

Dim rExp As Object, rMatch As Object 

Set rExp = CreateObject("vbscript.regexp") 
With rExp 
    .Global = False 
    .MultiLine = False 
    .IgnoreCase = True 
    .Pattern = regP 
End With 

Set rMatch = rExp.Execute(str) 
If rMatch.Count > 0 Then 
    regexp = rMatch(0) 
Else 
    RegEx = vbNullString 
    Debug.Print "No match found!" 
End If 

End Function 


Sub regexpAddress(str As String) 
Dim result As String 
Dim pattern As String 

If InStr(str, "Telephone:") Then pattern = "/.+?(?=Telephone:)/" 
result = regexp(str, pattern) 

End Sub 

我不知道怎么在这里形成的正则表达式。一个概述应该拉动正确的信息(1个字符串,而不是2,但这仍然是一个改进) - 但只有当该行包含字符串“电话:”,并且我有很多情况下,它不会包含该信息。

这是当前的,有点缺陷的逻辑,其中由于某种原因不总是产生我想要的结果:

For Each objMail In olFolder.Items 

name = "" 
address = "" 
telephone = "" 
email = "" 

vIterations = vIterations + 1 

arrBody = Split(objMail.body, Chr(10)) ' Split mail body when linebreak is encountered, throwing each line into its own array position 
For i = 0 To UBound(arrBody) 
    arrLine = Split(arrBody(i), ": ") ' For each element (line), make new array, and if text search matches then write the 2nd half of the element to variable 
    If InStr(arrBody(i), "Name:") > 0 Then ' L2 
     name = arrLine(1) ' Reference 2nd column in array after the split 
    ElseIf InStr(arrBody(i), "Address:") > 0 Then 
     address = arrLine(1) 
    ElseIf InStr(arrBody(i), "Telephone:") > 0 Then 
     telephone = CLng(arrLine(1)) 
    ElseIf InStr(arrBody(i), "Email:") > 0 Then 
     email = arrLine(1) 
    End If ' L2 
Next 
Next ' Next/end-for 

该逻辑接受和下述类型的格式输入:

Name: Joe 
Address: Road 
Telephone: 55555555555555 
Email: [email protected] 

并将joe,road,55555和[email protected]返回给某些定义的Excel单元格。当邮件按预期排序时,此工作正常。

问题:在某些情况下,一个错误导致我的webform不能在地址后面插入换行符。该脚本仍然工作的大部分,但的MailItem内容有时会结束这样看:

Name: Joe 
Address: Road Telephone: 55555555555555 
Email: [email protected] 

地址字段被污染,当它达到Excel文件(“路电话”,而不仅仅是“道”),但没有信息的损失。这是可以接受的,因为它很容易去除剩余的字符串。

但在以下情况下(不输入电子邮件),电话号码不仅丢失,而且实际上由其他任意mailitem的电话号码取代,我无法找到我的生活1)为什么它不会得到正确的号码,(2)为什么跳转到一个新的邮件项目,找到电话号码或(3)如何选择这个其他的MailItem:

Name: Joe 
Address: Road Telephone: 5555555555555 
Email: 

在Excel:

Name: Joe 
Address: Road Telephone 
Telephone: 8877445511 
Email: 

因此,TL; DR:我的选择逻辑是有缺陷的,因为它被如此匆匆砍死r,更不用说它是如何产生虚假信息的,我无法弄清楚如何以及为什么,我想用一些其他解决方案(如regexp?)来做更好的操作,而不是更强大的代码。

回答

0

我不知道这是愚蠢的运气还是如果我真的设法学习一些正则表达式,但这些模式完全是我所需要的。

' regex patterns - use flag /i 
adrPattern = "([a-z ]{2,}\s{0,1}\d{0,3})" ' Select from a-z or space, case insensitive and at least 2 characters long, followed by optional space, ending with 0-3 digits 
adrZipcode = "\b(\d{4})\b" ' Exactly 4 digits surrounded on both sides by either space, text or non-word character like comma 

编辑:“固定”电话问题。花了2个小时试图用正则表达式写出来,并且悲惨地失败之后,我发现解决问题的过程是错误创建数组的问题,比将它作为计算问题来处理要容易得多。它是:

mailHolder = Replace(objMail.body, "Telephone:", Chr(10) + "Telephone:") 
arrBody = Split(mailHolder, Chr(10)) 
0

不久前,我有一个类似的问题。 代码可能不是非常专业,但它可以帮助:) 你能检查这段代码是否能正确地为你工作吗?

Function regexp(str As String, regP As String) 

Dim rExp As Object, rMatch As Object 

Set rExp = CreateObject("vbscript.regexp") 
With rExp 
    .Global = False 
    .MultiLine = False 
    .IgnoreCase = True 
    .pattern = regP 
End With 

Set rMatch = rExp.Execute(str) 
If rMatch.Count > 0 Then 
    regexp = rMatch(0) 
Else 
    RegEx = vbNullString 
    Debug.Print "No match found!" 
End If 

End Function 

Function for_vsoraas() 

For Each objMail In olFolder.Items 

vIterations = vIterations + 1 

objMail_ = Replace(objMail.body, Chr(10), " ")  
Dim StringToSearch(3) As String 
StringToSearch(0) = "Name:" 
StringToSearch(1) = "Address:" 
StringToSearch(2) = "Telephone:" 
StringToSearch(3) = "Email:" 

Dim ArrResults(4) As String 'name,address,telephone,email, zipcode 

For i = 0 To UBound(StringToSearch) 
    ResultString = "" 
    StartString = InStr(objMail_, StringToSearch(i)) 
    If StartString > 0 Then 
     If i = UBound(StringToSearch) Then 'last string to search, dont search EndString 
     ResultString = Right(objMail_, Len(objMail_) + Len(StringToSearch(i))) 
     Else 
     EndString = 0 
     j = i 
     While (EndString = 0) 'prevent case no existing EndString 
     EndString = InStr(objMail_, StringToSearch(j + 1)) 
     j = j + 1 
      If j = UBound(StringToSearch) And EndString = 0 Then 
      EndString = Len(objMail_) + 1 
      End If 
     Wend 
     ResultString = Mid(objMail_, StartString + Len(StringToSearch(i)) + 1, EndString - 1 - StartString - Len(StringToSearch(i))) 

     End If 
    ArrResults(i) = ResultString 
    End If 
Next i 

'search zipcode and address 
ArrResults(4) = regexp(ArrResults(1), "\b(\d{5})\b") 
ArrResults(1) = regexp(ArrResults(1), "([a-z ]{2,}\s{0,1}\d{0,3})") 

'your varabile 
Name = ArrResults(0) 
Address = ArrResults(1) 
Telephone = ArrResults(2) 
Email = ArrResults(3) 
ZipCode = ArrResults(4) 

Next ' Next/end-for 
End Function