在accessvba中使用RegExp
我似乎无法正确使用VBA中的在accessvba中使用RegExp,regex,ms-access,vba,Regex,Ms Access,Vba,我似乎无法正确使用VBA中的RegExp函数。这就是我所拥有的，有谁能告诉我哪里出了问题，或者VBA中的一些用法示例。我不明白如何将RegExp找到的匹配项分配到变量或数组（）。当它命中RegEx.Execute时，我得到一个错误，说参数的数目不对 Dim RegEx As New RegExp Dim textOrders As String Dim RawText as String FileNum = FreeFile() Open FileName For Input As #File
RegExp变量数组（）。当它命中RegEx.Execute时，我得到一个错误，说参数的数目不对
Dim RegEx As New RegExp
Dim textOrders As String
Dim RawText as String
FileNum = FreeFile()
Open FileName For Input As #FileNum
Do Until EOF(FileNum)
Input #FileNum, ShortText
RawText = RawText & ShortText
loop
With RegEx
.Global = True
.MultiLine = False
.IgnoreCase = True
.Pattern = ("ORDER NUMBER :\s+[^\s]+\s+Ship Date:\s+[^\s]+\n\n\s+Style Desc : .+\n\s+Linecode : .+\n\s+Qty\s+.+")
End With
textOrders = RegEx.Execute(RawText) *This is where the error occurs*
然后我试了一下，但还是不走运
Sub GetMatches(ByRef Str As String, ByRef coll As Collection)
Dim rExp As Object, rMatch As Object
Set rExp = CreateObject("vbscript.regexp")
With rExp
.Global = True
.Pattern = "ORDER NUMBER :\s+[^\s]+\s+Ship Date:\s+[^\s]+\n\n\s+Style Desc : .+\n\s+Linecode : .+\n\s+Qty\s+.+"
End With
Set rMatch = rExp.Execute(Str)
If rMatch.Count > 0 Then
For Each rMatch In rMatch
coll.Add rMatch.Value
Debug.Print rMatch.Value
Next rMatch
End If
Debug.Print ""
End Sub
然后我尝试了这个：在JavaScript
Public Sub x()
Dim o As New ScriptControl
Dim OriginalText As String
Dim RegExPattern As String
OriginalText = ""
RegExPattern = ""
Str = "ORDER NUMBER : M0773175 Ship Date: 23-Nov-15" & _
"Style Desc : BLACKOUT CURTAINS CR 46X54" & _
"Linecode: M878966" & _
"Qty 36"
o.Language = "JScript"
With o
.AddCode "Function x() {return m(0);}" & _
"var str = Str;" & _
"var re = '/ORDER NUMBER :\s+[^\s]+\s+Ship Date:\s+[^\s]+\n\n\s+Style Desc : .+\n\s+Linecode : .+\n\s+Qty\s+.+/g';" & _
"var m;" & _
"while ((m = re.exec(str)) !== null) {" & _
"if (m.index === re.lastIndex) {" & _
"re.lastIndex++;" & _
"};" & _
"};"
Debug.Print .run("x", 1, 2)
End With
End Sub
尝试查找的模式的示例文本：
ORDER NUMBER : M0773175 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS CR 46X54
Linecode : M85466
Qty 36
要搜索的输入文本示例：它包含9个订单，但每次可能包含50或10个动态数量，这就是为什么尝试使用正则表达式
Purchase Order Supplier Copy Printed Date: 18/08/2015 3.32 PM Page 1 of 15
ORDER DETAILS INVOICE ADDRESS SHIPMENT & PAYMENT TERMS STYLE DETAILS
DATE: 18-AUG-15 ORDER NUMBERS: Purchase Ledger COM:CHINA STYLE DESCRIPTION SUPPLIER STYLE REF LINECODE
ORDER TYPE: Standard M0773175 M0773177 Retail Ltd COO:UK
SEASON: S16 M0773180 M0773183 Perimeter Road Port:UK BLACKOUT CURTAINS CR 46X54 HRW14CT001 M878966
DIVISION: HOMEWARE M0773186 M0773189 Knowsley Industrial Park Factory: BLACKOUT CURTAINS CR 66X72 HRW14CT001 M878967
DEPT: HOME FURNISHINGS M0773192 M0773195 Liverpool Buying Terms: BLACKOUT CURTAINS CR 90X90 HRW14CT001 M878972
BUYER: Harpal Rai-Hilton M0773198 United Kingdom Payment Terms:ENDMONTH BLACKOUT CURTAINS GR 46X54 HRW14CT001 M878974
SUPPLIER: L33 7SZ Shipping Method:LAND BLACKOUT CURTAINS GR 66X72 HRW14CT001 M878975
AGENT: 9999 N/A 0151 Pack Desc:Solid Boxed BLACKOUT CURTAINS GR 90X90 HRW14CT001 M878976
Currency:STERL
BLACKOUT CURTAINS BG 46X54 HRW14CT001 M878977
FOB value:5086.62
BLACKOUT CURTAINS BG 66X72 HRW14CT001 M878978
BLACKOUT CURTAINS BG 90X90 HRW14CT001 M878979
PRODUCTION SUMMARY
GRAND TOTAL
ORDER NUMBER : M0773175 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS CR 46X54
Linecode : M878966
Qty 36
ORDER NUMBER : M0773177 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS CR 66X72
Linecode : M878967
Qty 27
ORDER NUMBER : M0773180 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS CR 90X90
Linecode : M878972
Qty 38
ORDER NUMBER : M0773183 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS GR 46X54
Linecode : M878974
Qty 30
ORDER NUMBER : M0773186 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS GR 66X72
Linecode : M878975
Qty 15
ORDER NUMBER : M0773189 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS GR 90X90
Linecode : M878976
Qty 60
ORDER NUMBER : M0773192 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS BG 46X54
Linecode : M878977
Qty 42
ORDER NUMBER : M0773195 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS BG 66X72
Linecode : M878978
Qty 21
ORDER NUMBER : M0773198 Ship Date: 23-Nov-15
Style Desc : BLACKOUT CURTAINS BG 90X90
Linecode : M878979
Qty 40
我认为正则表达式可能存在一个问题，即换行符的数量（及其类型）可能与预期不符（\r\n
或只是\n
？）。我认为切换到只匹配任何可选空格的\s*
更安全
正则表达式看起来像
ORDER NUMBER\s*:\s*\S+\s*Ship Date:\s*\S+\s*Style Desc : .+\s*Linecode\s*: .+\s*Qty\s*.+
见
以下是有效的代码：
收集所有匹配项的子项：
Sub GetMatches2(ByRef str As String, ByRef coll As collection)
Dim rExp As Object, rMatch As Object, r_item As Object
Set rExp = CreateObject("vbscript.regexp")
With rExp
.Global = True
.MultiLine = False
.IgnoreCase = True
.pattern = "ORDER NUMBER\s*:\s*\S+\s*Ship Date:\s*\S+\s*Style Desc : .+\s*Linecode\s*: .+\s*Qty\s*.+"
End With
Set rMatch = rExp.Execute(str)
If rMatch.Count > 0 Then
For Each r_item In rMatch
coll.Add r_item.Value
Next r_item
End If
End Sub
以及将字符串传递到GetMatches2
的主子节点：
Sub ProcessStr()
Dim s As String
s = "Purchase Order Supplier Copy Printed Date: 18/08/2015 3.32 PM Page 1 of 15" & vbCrLf & vbCrLf & " ORDER DETAILS INVOICE ADDRESS SHIPMENT & PAYMENT TERMS STYLE DETAILS" & vbCrLf & "" & vbCrLf & " DATE: 18-AUG-15 ORDER NUMBERS: Purchase Ledger COM:CHINA STYLE DESCRIPTION SUPPLIER STYLE REF LINECODE" & vbCrLf & " ORDER TYPE: Standard M0773175 M0773177 Retail Ltd COO:UK" & vbCrLf & " SEASON: S16 M0773180 M0773183 Perimeter Road Port:UK BLACKOUT CURTAINS CR 46X54 HRW14CT001 M878966" & vbCrLf & _
" DIVISION: HOMEWARE M0773186 M0773189 Knowsley Industrial Park Factory: BLACKOUT CURTAINS CR 66X72 HRW14CT001 M878967" & vbCrLf & " DEPT: HOME FURNISHINGS M0773192 M0773195 Liverpool Buying Terms: BLACKOUT CURTAINS CR 90X90 HRW14CT001 M878972" & vbCrLf & " BUYER: Harpal Rai-Hilton M0773198 United Kingdom Payment Terms:ENDMONTH BLACKOUT CURTAINS GR 46X54 HRW14CT001 M878974" & vbCrLf & " SUPPLIER: L33 7SZ Shipping Method:LAND BLACKOUT CURTAINS GR 66X72 HRW14CT001 M878975" & vbCrLf & " AGENT: 9999 N/A 0151 Pack Desc:Solid Boxed BLACKOUT CURTAINS GR 90X90 HRW14CT001 M878976" & _
vbCrLf & " Currency:STERL" & vbCrLf & _
" BLACKOUT CURTAINS BG 46X54 HRW14CT001 M878977" & vbCrLf & " FOB value:5086.62" & vbCrLf & " BLACKOUT CURTAINS BG 66X72 HRW14CT001 M878978" & vbCrLf & " BLACKOUT CURTAINS BG 90X90 HRW14CT001 M878979" & vbCrLf & vbCrLf & _
" PRODUCTION SUMMARY" & vbCrLf & vbCrLf & " GRAND TOTAL" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773175 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS CR 46X54" & vbCrLf & " Linecode : M878966" & vbCrLf & " Qty 36" & vbCrLf & vbCrLf & _
" ORDER NUMBER : M0773177 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS CR 66X72" & vbCrLf & " Linecode : M878967" & vbCrLf & " Qty 27" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773180 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & _
" Style Desc : BLACKOUT CURTAINS CR 90X90" & vbCrLf & " Linecode : M878972" & vbCrLf & " Qty 38" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773183 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 46X54" & vbCrLf & " Linecode : M878974" & vbCrLf & " Qty 30" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773186 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 66X72" & vbCrLf & _
" Linecode : M878975" & vbCrLf & " Qty 15" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773189 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 90X90" & vbCrLf & " Linecode : M878976" & vbCrLf & " Qty 60" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773192 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & _
" Style Desc : BLACKOUT CURTAINS BG 46X54" & vbCrLf & " Linecode : M878977" & vbCrLf & " Qty 42" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773195 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS BG 66X72" & vbCrLf & _
" Linecode : M878978" & vbCrLf & " Qty 21" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773198 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS BG 90X90" & vbCrLf & _
" Linecode : M878979" & vbCrLf & " Qty 40"
Dim matches As collection
Set matches = New collection
GetMatches2 str:=s, coll:=matches
End Sub
结果:
我认为正则表达式可能存在一个问题，换行符的数量（及其类型）可能与预期不符（\r\n
或只是\n
？）。我认为切换到只匹配任何可选空格的\s*
更安全
正则表达式看起来像
ORDER NUMBER\s*:\s*\S+\s*Ship Date:\s*\S+\s*Style Desc : .+\s*Linecode\s*: .+\s*Qty\s*.+
见
以下是有效的代码：
收集所有匹配项的子项：
Sub GetMatches2(ByRef str As String, ByRef coll As collection)
Dim rExp As Object, rMatch As Object, r_item As Object
Set rExp = CreateObject("vbscript.regexp")
With rExp
.Global = True
.MultiLine = False
.IgnoreCase = True
.pattern = "ORDER NUMBER\s*:\s*\S+\s*Ship Date:\s*\S+\s*Style Desc : .+\s*Linecode\s*: .+\s*Qty\s*.+"
End With
Set rMatch = rExp.Execute(str)
If rMatch.Count > 0 Then
For Each r_item In rMatch
coll.Add r_item.Value
Next r_item
End If
End Sub
以及将字符串传递到GetMatches2
的主子节点：
Sub ProcessStr()
Dim s As String
s = "Purchase Order Supplier Copy Printed Date: 18/08/2015 3.32 PM Page 1 of 15" & vbCrLf & vbCrLf & " ORDER DETAILS INVOICE ADDRESS SHIPMENT & PAYMENT TERMS STYLE DETAILS" & vbCrLf & "" & vbCrLf & " DATE: 18-AUG-15 ORDER NUMBERS: Purchase Ledger COM:CHINA STYLE DESCRIPTION SUPPLIER STYLE REF LINECODE" & vbCrLf & " ORDER TYPE: Standard M0773175 M0773177 Retail Ltd COO:UK" & vbCrLf & " SEASON: S16 M0773180 M0773183 Perimeter Road Port:UK BLACKOUT CURTAINS CR 46X54 HRW14CT001 M878966" & vbCrLf & _
" DIVISION: HOMEWARE M0773186 M0773189 Knowsley Industrial Park Factory: BLACKOUT CURTAINS CR 66X72 HRW14CT001 M878967" & vbCrLf & " DEPT: HOME FURNISHINGS M0773192 M0773195 Liverpool Buying Terms: BLACKOUT CURTAINS CR 90X90 HRW14CT001 M878972" & vbCrLf & " BUYER: Harpal Rai-Hilton M0773198 United Kingdom Payment Terms:ENDMONTH BLACKOUT CURTAINS GR 46X54 HRW14CT001 M878974" & vbCrLf & " SUPPLIER: L33 7SZ Shipping Method:LAND BLACKOUT CURTAINS GR 66X72 HRW14CT001 M878975" & vbCrLf & " AGENT: 9999 N/A 0151 Pack Desc:Solid Boxed BLACKOUT CURTAINS GR 90X90 HRW14CT001 M878976" & _
vbCrLf & " Currency:STERL" & vbCrLf & _
" BLACKOUT CURTAINS BG 46X54 HRW14CT001 M878977" & vbCrLf & " FOB value:5086.62" & vbCrLf & " BLACKOUT CURTAINS BG 66X72 HRW14CT001 M878978" & vbCrLf & " BLACKOUT CURTAINS BG 90X90 HRW14CT001 M878979" & vbCrLf & vbCrLf & _
" PRODUCTION SUMMARY" & vbCrLf & vbCrLf & " GRAND TOTAL" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773175 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS CR 46X54" & vbCrLf & " Linecode : M878966" & vbCrLf & " Qty 36" & vbCrLf & vbCrLf & _
" ORDER NUMBER : M0773177 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS CR 66X72" & vbCrLf & " Linecode : M878967" & vbCrLf & " Qty 27" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773180 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & _
" Style Desc : BLACKOUT CURTAINS CR 90X90" & vbCrLf & " Linecode : M878972" & vbCrLf & " Qty 38" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773183 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 46X54" & vbCrLf & " Linecode : M878974" & vbCrLf & " Qty 30" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773186 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 66X72" & vbCrLf & _
" Linecode : M878975" & vbCrLf & " Qty 15" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773189 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS GR 90X90" & vbCrLf & " Linecode : M878976" & vbCrLf & " Qty 60" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773192 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & _
" Style Desc : BLACKOUT CURTAINS BG 46X54" & vbCrLf & " Linecode : M878977" & vbCrLf & " Qty 42" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773195 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS BG 66X72" & vbCrLf & _
" Linecode : M878978" & vbCrLf & " Qty 21" & vbCrLf & vbCrLf & " ORDER NUMBER : M0773198 Ship Date: 23-Nov-15" & vbCrLf & vbCrLf & " Style Desc : BLACKOUT CURTAINS BG 90X90" & vbCrLf & _
" Linecode : M878979" & vbCrLf & " Qty 40"
Dim matches As collection
Set matches = New collection
GetMatches2 str:=s, coll:=matches
End Sub
结果:
textOrders
声明为字符串，但是RegEx.Execute
将返回一个匹配对象。@Stribizev那么如何访问匹配对象以从文件中取出文本块呢？我知道我可能必须改变它的工作模式，但似乎不能在VBA中使用它。请看一看。您可以找到满足您需要的GetMatches
函数。如果没有，请让我知道。如果该解决方案无法解决您的问题，我将重新打开该问题。@Stribizev hi您的示例让我更加困惑，请您打开问题备份cheerstextOrders
声明为字符串，但是，RegEx.Execute
将返回一个匹配对象。@Stribizev那么如何访问匹配对象以从文件中取出文本块呢？我知道我可能必须改变它的工作模式，但似乎不能在VBA中使用它。请看一看。您可以找到满足您需要的GetMatches
函数。如果没有，请让我知道。如果该解决方案不能解决您遇到的问题，我将重新打开该问题。@Stribizev hi您的示例让我更加困惑，请您打开问题备份。我仍然在r_项
上得到错误“variable not defined”（未定义变量）Dim r_项作为对象Option Explicitr\u项上得到错误“variable not defined”Dim r\u项为ObjectOption Explicit