Subscript out of range when copying to cell [closed] - excel

Question

Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 5 years ago.
Improve this question
I am trying to extract Data from emails by using this script I found online with some changes to run for my specific information:
Option Explicit
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim olItem As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Const strPath As String = "C:\Users\Rob\Documents\Excel\ExcelTest.xlsx" 'the path of the workbook
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
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 the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
'Process each selected record
rCount = xlSheet.UsedRange.Rows.Count
For Each olItem In Application.ActiveExplorer.Selection
sText = olItem.Body
vText = Split(sText, Chr(13))
'Find the next empty line of the worksheet
rCount = rCount + 1
'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "Destination -") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("A" & rCount) = Trim(vItem(1))
End If
Next i
xlWB.Save
Next olItem
xlWB.Close SaveChanges:=True
If bXStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
End Sub
The information I have to extract from the emails are shown below in BOLD.
Destination State - Pennsylvania
Destination - Pittsburgh
UK Airport - London Gatwick
Airline - United Airlines
Flight Class - Premium - from £499
Depart Date - 27/07/2011
Return Date - 10/08/2011
Adults - 2
Children - 1
First Name - Andrew
Last Name - Leakey
Telephone - 07785 496123 // Number Is fake
Contact Email - AmdrewsEmail#Email.org.uk
When I run the code it says "Subscript out of range" and the debugger says it is occurring on this line.
xlSheet.Range("A" & rCount) = Trim(vItem(1))

Answer 1

Replace this:
vItem = Split(vText(i), Chr(58))
with this:
vItem = Split(vText(i),"-")