Как разделить на новую ячейку в Excel после каждого "-" в теме из электронных писем Outlook - PullRequest
Новая
       6

Как разделить на новую ячейку в Excel после каждого "-" в теме из электронных писем Outlook

0 голосов
/ 11 февраля 2019

Я пытаюсь получить строку после слова, которое дает мне необходимые данные и все фразы после каждого "-", в новую ячейку в Excel, кроме RE:, где я опускаю "RE:" и оставляю толькоTS ... ID билета.

Этот код работает, выбирая электронные письма в outlook, а затем запуская макрос только для выбранных электронных писем.

Это пример темы, которая имеет

Пример темы

RE: TS001889493 - Ошибка перевода - Входящий - (VEXP/ HONCE / Тип документа 214 - Карта AVE_NMHG_I_214_4010_XML_SAT - Ошибка условной ошибки отношения в N103 (0066) [ref: _00D50c9MW._5000z1J3cG8: ref]

Пример тела 1015

1016 *

Уважаемый торговый партнер,

Мы получили прикрепленные 214 транзакций от идентификатора отправителя: VEXP / идентификатор получателя: HONCE, который не состоялся из-за ошибки условных отношений в N1_03 (0066).

Asсогласно логике карты, если присутствует N103 или N104, то требуется другое, так как они находятся в условной взаимосвязи друг с другом, но в полученном входном файле значение N104 отсутствует, следовательно, ошибка.

ТранзакцияПодробности: # 4 # В приложении

Пожалуйста, исправьте и повторно отправьте данные.

Спасибо, Саймон Хаггс | Поддержка Sass - Basic

ref: _00D50c9MW._5000z1J3cG8: ref

Что происходит в # num #, так это то, что он получает сумму всех этих значений после сопоставления идентификатора билета "TS".

Это код, который у меня есть до сих пор 

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 = "TS00\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 = "T.S\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

1 Ответ

0 голосов
/ 11 февраля 2019

Вы можете использовать функцию SPLIT в VBA, что-то вроде этого 

Sub x()

Dim s As String
Dim a() As String

s = "this-will-test-this-out"

a = Split(s, "-")

Range("a1").Resize(UBound(a) + 1, 1).Value = Application.Transpose(a)

End Sub
...