SPORTS FANZ Order #62659
June 24, 2023
SHIP TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
BILL TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
ITEMS QUANTITY
Virginia Tech Hokies Basketball Cassell Coliseum Panoramic
Picture
Virginia Tech Hokies Panoramic Picture Select
VAT5M
1 of 1
Thank you for shopping with us!
Sports Fanz
123 Liberty St, Chester NY 12345, United States

SPORTS FANZ Order #12345
June 24, 2023
SHIP TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
(123) 123-4567
BILL TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
ITEMS QUANTITY
Virginia Tech Hokies Basketball Cassell Coliseum Panoramic
Picture
Virginia Tech Hokies Panoramic Picture Select
VAT5M
2 of 2
Thank you for shopping with us!
Sports Fanz
123 Liberty St, Chester NY 12345, United States

SPORTS FANZ Order #58083
January 6, 2023
SHIP TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
+12345678900
BILL TO
Abe Lincoln
123 Main St
New York, NY 12345
United States
ITEMS QUANTITY
Nebraska Cornhuskers Women's Volleyball Devaney Center Panoramic Picture
Nebraska Cornhuskers Panoramic Picture Select Frame
UNE11M
1 of 1
Kansas City Chiefs Super Bowl 54 Champions Panoramic Picture
Kansas City Chiefs SB 54 Champions Panoramic Picture Unframed
NFLSBC20CHF
1 of 1
Thank you for shopping with us!
Sports Fanz
123 Liberty St, Chester NY 12345, United States

Public Function SuperMid(ByVal strMain As String, str1 As String, str2 As String, Optional reverse As Boolean) As String
'DESCRIPTION: Extract the portion of a string between the two substrings defined in str1 and str2.
'DEVELOPER: Ryan Wells (wellsr.com)
'HOW TO USE: - Pass the argument your main string and the 2 strings you want to find in the main string.
' - This function will extract the values between the end of your first string and the beginning
' of your next string.
' - If the optional boolean "reverse" is true, an InStrRev search will occur to find the last
' instance of the substrings in your main string.
Dim i As Integer, j As Integer, temp As Variant
On Error GoTo errhandler:
If reverse = True Then
i = InStrRev(strMain, str1)
j = InStrRev(strMain, str2)
If Abs(j - i) < Len(str1) Then j = InStrRev(strMain, str2, i)
If i = j Then 'try to search 2nd half of string for unique match
j = InStrRev(strMain, str2, i - 1)
End If
Else
i = InStr(1, strMain, str1)
j = InStr(1, strMain, str2)
If Abs(j - i) < Len(str1) Then j = InStr(i + Len(str1), strMain, str2)
If i = j Then 'try to search 2nd half of string for unique match
j = InStr(i + 1, strMain, str2)
End If
End If
If i = 0 And j = 0 Then GoTo errhandler:
If j = 0 Then j = Len(strMain) + Len(str2) 'just to make it arbitrarily large
If i = 0 Then i = Len(strMain) + Len(str1) 'just to make it arbitrarily large
If i > j And j <> 0 Then 'swap order
temp = j
j = i
i = temp
temp = str2
str2 = str1
str1 = temp
End If
i = i + Len(str1)
SuperMid = Mid(strMain, i, j - i)
Exit Function
errhandler:
MsgBox "Error extracting strings. Check your input" & vbNewLine & vbNewLine & "Aborting", , "Strings not found"
End
End Function

Sub extractPDF()
Dim phoneNumber, shippingInfo, shippingAddress, itemInfo, poNumber As String
Dim iTxtFile As Integer
Dim strFile As String
Dim strFileText As String
strFile = "C:\blah\blah\blah\#62875.txt"
iTxtFile = FreeFile
Open strFile For Input As FreeFile
strFileText = Input(LOF(iTxtFile), iTxtFile)
Close iTxtFile
Dim regexPattern As String
Dim regex As Object
Dim matches As Object
Dim match As Object
' Regular expression pattern
regexPattern = "Order #\d{5}"
' Create a regular expression object
Set regex = CreateObject("VBScript.RegExp")
' Set the pattern and ignore case
With regex
.Pattern = regexPattern
.IgnoreCase = True
End With
' Perform the search
Set matches = regex.Execute(strFileText)
' Loop through the matches
For Each match In matches
' Print the matched value
poNumber = Right(match, 5)
Next match
shippingInfo = SuperMid(strFileText, "SHIP TO", "BILL TO")
shippingAddress = SuperMid(shippingInfo, "", "United States")
phoneNumber = Application.WorksheetFunction.Clean(SuperMid(shippingInfo, "United States", "BILL TO"))
itemInfo = SuperMid(strFileText, "ITEMS QUANTITY", "Thank you for shopping with us!")
Debug.Print "PO #: " & poNumber
Debug.Print "Phone Number: " & phoneNumber
Debug.Print shippingAddress
Debug.Print itemInfo
End Sub

Function ExtractDat(arrTxt) As Variant
Dim arrFin, mtch, arrH, arr, i As Long, k As Long
'                                                           0                       1                        2                3             4       5       6          7             8                9                      10        11      12     13        14         15              16             17             18
Const header As String = "Order number, (Ship To) Name, Address1, Address2, City, State, Zip, Country, Phone, (Bill To) Name, Address, City, State, Zip, Country, SKU1, Value SKU1, SKU2, Value SKU2"
arrH = Split(header, ",")
ReDim arrFin(UBound(arrH))
With CreateObject("Vbscript.RegExp")
.Pattern = "\d{5}"
.Global = False
arrFin(0) = .Execute(arrTxt(0))(0) 'order number
End With
arrFin(1) = arrTxt(3)             'Send To Name
arrFin(2) = arrTxt(4)             'Send To Address
arrFin(3) = ""                    'No second Address (assumption...)
mtch = Application.match("BILL TO", arrTxt, 0)
If IsError(mtch) Then MsgBox """BILL TO" & " could not be found in the analyzed data...", vbInformation, "BILL TO missing": Exit Function
If mtch = 8 Then 'no Phone number existing, no second Address, too...
arr = Split(arrTxt(5), ", ") 'split City from State and Zip
arrFin(4) = arr(0)            'Send To City
arrFin(5) = Split(arr(1))(0)  'Send To State
arrFin(6) = Split(arr(1))(1)  'Send To Zip
arrFin(7) = arrTxt(6)         'Country
arrFin(8) = ""                'No Phone number
ElseIf mtch = 9 Then
If InStr(arrTxt(5), ",") = 0 Then 'no comma in string (second address...)
arrFin(3) = arrTxt(5)         'second Address
arr = Split(arrTxt(6), ", ")  'split City from State and Zip
arrFin(4) = arr(0)            'Send To City
arrFin(5) = Split(arr(1))(0)  'Send To State
arrFin(6) = Split(arr(1))(1)  'Send To Zip
arrFin(7) = arrTxt(6)         'Country
arrFin(8) = ""                'No Phone number
Else    'No second address
arr = Split(arrTxt(5), ", ")   'split City from State and Zip
arrFin(4) = arr(0)            'Send To City
arrFin(5) = Split(arr(1))(0)  'Send To State
arrFin(6) = Split(arr(1))(1)  'Send To Zip
arrFin(7) = arrTxt(6)         'Country
arrFin(8) = arrTxt(7)         'Phone number
End If
ElseIf mtch = 10 Then 'second Address and Phone number exist
arrFin(3) = arrTxt(5)         'second Address
arr = Split(arrTxt(6), ", ")  'split City from State and Zip
arrFin(4) = arr(0)            'Send To City
arrFin(5) = Split(arr(0))(0)  'Send To State
arrFin(6) = Split(arr(0))(1)  'Send To Zip
arrFin(7) = arrTxt(7)         'Country
arrFin(8) = arrTxt(8)         'Phone number
End If
arrFin(9) = arrTxt(mtch)        'Bill To Name
arrFin(10) = arrTxt(mtch + 1)   'Bill To Address
arr = Split(arrTxt(mtch + 2), ", ")
arrFin(11) = arr(0)             'Bill To City
arrFin(12) = Split(arr(1))(0)   'Bill To State
arrFin(13) = Split(arr(1))(1)   'Bill To Zip
arrFin(14) = arrTxt(mtch + 3)    'Bill To Country
'extract SCUs and their values:
For i = 0 To UBound(arrTxt)
If arrTxt(i) Like "#* of #*" Then
arrFin(15 + k) = arrTxt(i - 1)
arrFin(16 + k) = Split(arrTxt(i))(0)
k = k + 2
End If
Next i
ExtractDat = Array(arrH, arrFin)
End Function
```
It can be used to return in the active sheet with such a code. It processes a text file, placing its content in an array and returns on the first two rows of the active sheet:
```
Sub UseExtractDat()
Dim strFile As String, arrT, retArr
strFile = "C:\blah\blah\blah\#62875.txt"
'Place the content of the text file in an array (splitting by end of line)
arrT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(strFile, 1).ReadAll, vbCrLf)
retArr = ExtractDat(arrT)
Range("A1").Resize(1, UBound(retArr(0)) + 1).Value2 = retArr(0)
Range("A2").Resize(1, UBound(retArr(1)) + 1).Value2 = retArr(1)
End Sub
```
Please, send some feedback after testing it.
</details>
# 答案2
**得分**: 1
以下是代码的翻译部分：
```vba
如果您在单元格 A1 中存储了一个文本字符串，并且您想要使用以下代码获取 SKU 和数量。
Sub Demo()
Dim objRegExp As Object
Dim objMatches As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.IgnoreCase = True
.Global = True
.Pattern = "([A-Z0-9]+)\s*(\d+) of \d+"
If .Test([a1]) Then
Set objMatches = objRegExp.Execute([a1])
For Each objMtch In objMatches
With objMtch.submatches
If .Count = 2 Then
SKU = .Item(0)
QTY = .Item(1)
Debug.Print "SKU:" & SKU & vbNewLine _
& "Quantity:" & QTY
End If
End With
Next
End If
End With
Set objMatches = Nothing
Set objRegExp = Nothing
End Sub
```
<details>
<summary>英文:</summary>
If you have a text string stored in cell A1 and you would get SKU and Quantity with following code.
```
Sub Demo()
Dim objRegExp As Object
Dim objMatches As Object
Set objRegExp = CreateObject(&quot;vbscript.regexp&quot;)
With objRegExp
.IgnoreCase = True
.Global = True
.Pattern = &quot;([A-Z0-9]+)\s*(\d+) of \d+&quot;
If .Test([a1]) Then
Set objMatches = objRegExp.Execute([a1])
For Each objMtch In objMatches
With objMtch.submatches
If .Count = 2 Then
SKU = .Item(0)
QTY = .Item(1)
Debug.Print &quot;SKU:&quot; &amp; SKU &amp; vbNewLine _
&amp; &quot;Quantity:&quot; &amp; QTY
End If
End With
Next
End If
End With
Set objMatches = Nothing
Set objRegExp = Nothing
End Sub
```
</details>