Я пытаюсь получить текст сразу после - Map в данном примере это «AVE_NMHG_I_214_4010_XML_SAT» и введите его в каждую строку «Имя карты» в столбце до тех пор, пока следующий найденный пробел не может оказаться «AVE_I_214_4010» какдругой пример.
именно здесь я пытаюсь привести это в соответствие.
Dim tmp As String
Dim RegX2 As Object, Mats1 As Object
tmp = strColS
Set RegX2 = CreateObject("VBScript.RegExp")
With RegX2
.Global = True
.Pattern = "Map\d{7}"
Set Mats1 = .Execute(tmp)
End With
If (RegX2.Test(tmp)) Then
Set Mats1 = RegX2.Execute(tmp)
tmp = Mats1(0)
Else
With RegX2
.Pattern = "MAP\d{9}"
Set Mats1 = .Execute(tmp)
End With
If (RegX.Test(tmp)) Then
tmp = Mats1(0)
End If
End If
Set Mats1 = Nothing
Set RegX2 = Nothing
Примечание: карта не всегда указывается, а иногда определяется как карта или карта.
Этот код работает, выбирая электронные письма в outlook, а затем запускает макрос только для тех выбранных электронных писем.
Это пример темы, которая имеет
Пример темы
RE: TS001889493 - Translation failure - Inbound - ( VEXP/ HONCE/ Document Type 214 - Map AVE_NMHG_I_214_4010_XML_SAT - Error Conditional Relationship Error in N103 (0066) [ ref:_00D50c9MW._5000z1J3cG8:ref ]
Пример тела
Dear Valued Trading Partner,
We received the attached 214 transactions from Sender ID: VEXP/ Receiver ID: HONCE that failed due to Conditional Relationship Error in the N1_03 (0066).
As per the map logic, If either N103 or N104 is present, then the other is required as they are in conditional relationship with each other. But in the input file received, N104 value is missing hence the error.
Transaction Details: #4# Attached
Please correct and resend the data.
Thank you, Simon Huggs | Sass support - Basic
То, что происходит в # num #, заключается в том, что он получает сумму всего этого после сопоставления тикета "TS"ID.
Это код, который у меня есть до сих пор
Option Explicit
Sub WritingTicketNumberAndfailuresnew()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount, STicket, SticketNumber As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath, SSubject As String
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColS, strColB, sassupport, sMailDateReceived, SFrom As String
Dim Actions1, Actions2, Actions3, Actions4 As Boolean
Dim I, cnt, email_needed As Integer
' Get Excel set up
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open a specific workbook to input the data the path of the workbook under the windows user account
enviro = CStr(Environ("USERPROFILE"))
strPath = enviro & "\Documents\topthreeticket.xlsx"
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
' Add column names
xlSheet.Range("A1") = "Email Subject"
xlSheet.Range("B1") = "Map Name"
xlSheet.Range("C1") = "Case Number"
xlSheet.Range("D1") = "No. Of Failures"
xlSheet.Range("E1") = "Date"
xlSheet.Range("F1") = "Week Number"
sassupport = "sassuport@sass.com"
On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1
' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection
Set olItem = obj
'collect the fields for ticket number and failure count
strColS = olItem.Subject
strColB = olItem.Body
SFrom = olItem.SenderEmailAddress
sMailDateReceived = olItem.ReceivedTime
Dim sFailures, stmp1, stmp2, stmp3 As String
Dim RegX As Object, Mats As Object
Dim Found As Boolean
' Check the number of failures from body
sFailures = "0"
stmp1 = strColB
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.Pattern = "#\d+#"
Set Mats = .Execute(stmp1)
End With
If (RegX.Test(stmp1)) Then
stmp2 = Mats(0)
Found = True
stmp3 = Mid(stmp2, 2, Len(stmp2) - 2)
sFailures = stmp3
Else
With RegX
.Pattern = "#d\d+"
Set Mats = .Execute(stmp1)
End With
If (RegX.Test(stmp1)) Then
stmp2 = Mats(0)
Found = True
stmp3 = Mid(stmp2, 2, Len(stmp2) - 1)
sFailures = stmp3
End If
End If
Set Mats = Nothing
Set RegX = Nothing
Dim tmp As String
Dim RegX2 As Object, Mats1 As Object
tmp = strColS
Set RegX2 = CreateObject("VBScript.RegExp")
With RegX2
.Global = True
.Pattern = "Map\d{7}"
Set Mats1 = .Execute(tmp)
End With
If (RegX2.Test(tmp)) Then
Set Mats1 = RegX2.Execute(tmp)
tmp = Mats1(0)
Else
With RegX2
.Pattern = "MAP\d{9}"
Set Mats1 = .Execute(tmp)
End With
If (RegX.Test(tmp)) Then
tmp = Mats1(0)
End If
End If
Set Mats1 = Nothing
Set RegX2 = Nothing
Dim tempticketnum, tmpdate As String
Dim ticketnumposition As Integer
'write them in the excel sheet
If SFrom = sassupport Then
xlSheet.Range("A" & rCount) = strColS
xlSheet.Range("B" & rCount) = tmp2
xlSheet.Range("C" & rCount) = tmp
xlSheet.Range("D" & rCount) = sFailures ' number of failures
xlSheet.Range("E" & rCount) = sMailDateReceived
rCount = rCount + 1
End If
Next
Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub