vba excel outlook help please.

[gambit59]

I pretty much changed few variable names from my old code.
and i got "Run-time error '5': Invalid Procedure call or argument"
on the red line.

Im very new to this website, so please help me.

Thanks in advance.
--------------------------------------------------------------


Public Const filePath As String = "C:\Testsheet.xlsb"

Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim properties As Variant
Dim emptyRow As Integer
Dim index As Integer
Dim oldIndex As Integer
Dim stepSize As Integer

Sub OnReceiveMail3(mail As MailItem)

'Make sure the subject matches Standard Form, otherwise ignore the email.
If mail.Subject = "IT - Contract - Candidate Rejected" Then
Dim wroteToTemp As Boolean
'Open the spreadsheet containing the list of interviews. Grabs the fifth worksheet to avoid problems with formatting and sorting
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(filePath)

If oBook.ReadOnly Then

'If the temporary file already exists, then edit it instead, to preserve any other names that may still be in the queue to get added
If Len(Dir(Left(filePath, Len(filePath) - 5) & " (Temporary).xlsb")) <> 0 Then

Call oBook.Close
Set oBook = oExcel.Workbooks.Open(Left(filePath, Len(filePath) - 5) & " (Temporary).xlsb")
wroteToTemp = True

End If

End If

Set oSheet = oBook.WorkSheets(1)

stepSize = 3
index = 2

'Find a general range of where the next empty row is. Each iteration, the range size increases by one until an empty row is found
Do While Not IsEmpty(oSheet.Range("A" & index))

oldIndex = index
index = index + stepSize
stepSize = stepSize + 1

Loop

'If the document is not empty, then we need to backtrack as we (most likely) overstepped
If index <> 2 Then

'While the current row is empty, move back one row
Do While IsEmpty(oSheet.Range("A" & index))

index = index - 1

Loop

'Move to the next row as the current row has text on it
index = index + 1

End If

emptyRow = index

properties = createArrayOfProperties(mail.body)

'Fill in the spreadsheet with the properties
oSheet.Range("I" & emptyRow).Value = properties(Trim(LBound(properties)))
oSheet.Range("A" & emptyRow).Value = properties(Trim(LBound(properties)) + 1)
oSheet.Range("D" & emptyRow).Value = properties(Trim(LBound(properties)) + 2)
oSheet.Range("J" & emptyRow).Value = properties(Trim(LBound(properties)) + 3)
oSheet.Range("B" & emptyRow).Value = properties(Trim(LBound(properties)) + 4)
oSheet.Range("K" & emptyRow).Value = properties(Trim(LBound(properties)) + 5)
oSheet.Range("E" & emptyRow).Value = properties(Trim(LBound(properties)) + 6)
oSheet.Range("L" & emptyRow).Value = properties(Trim(LBound(properties)) + 7)
oSheet.Range("G" & emptyRow).Value = properties(Trim(LBound(properties)) + 8)
oSheet.Range("H" & emptyRow).Value = properties(Trim(LBound(properties)) + 9)

'Quit out of the excel spreadsheet
oExcel.DisplayAlerts = False

'If the spreadsheet is being edit by another person, then alert the user and save it to the temporary spreadsheet
If oBook.ReadOnly Or wroteToTemp Then

MsgBox "The file is currently being used by another recruiter. The most recent candidate (" & properties(Trim(LBound(properties)) + 1) & ") has been added to a copy of the spreadsheet, located in " & oBook.Path & "\Testsheet (Temporary).xlsb. When the other user is done editing the spreadsheet, you must move the most recent candidate from the copy of the spreadsheet to the original."
Call oBook.SaveAs(oBook.Path & "\Testsheet (Temporary).xlsb")

Else

oBook.Save

End If

oBook.Close
oExcel.Quit

Set oExcel = Nothing
Set oBook = Nothing

End If


End Sub

Private Function substring(ByVal text As String, ByVal startIndex As Integer, ByVal endIndex As Integer) As String

'Gets a subsection of a string
substring = Left(Right(text, Len(text) - startIndex), endIndex - startIndex)

End Function

Private Function createArrayOfProperties(ByVal text As String) As Variant

'On Error Resume Next
'Searches through the email body and retrieves the relevent text, and then puts it into an array and returns the array
Dim Eng As String
Dim cName As String
Dim Pos As String
Dim Sup As String
Dim jDate As String
Dim Shift As String
Dim Org As String
Dim CostC As String
Dim rReason As String
Dim Cmts As String

Eng = substring(text, InStr(text, "activity. ") + 8, InStr(text, "Candidate: ") - 2)
cName = substring(text, InStr(text, "Candidate: ") + 10, InStr(text, "Position: ") - 2)
Dim temp As String
temp = substring(cName, InStr(cName, ",") + 1, Len(cName))
cName = temp & " " & substring(cName, 0, InStr(cName, ",") - 1)
Pos = substring(text, InStr(text, "Position: ") + 9, InStr(text, "Supplier: ") - 2)
Sup = substring(text, InStr(text, "Supplier: ") + 9, InStr(text, "Start/End Dates: ") - 2)
jDate = substring(text, InStr(text, "Start/End Dates: ") + 16, InStr(text, "Scheduled Shift: ") - 2)
Shift = substring(text, InStr(text, "Scheduled Shift: ") + 16, InStr(text, "Organization: ") - 2)
Org = substring(text, InStr(text, "Organization: ") + 13, InStr(text, "Cost Center: ") - 2)
CostC = substring(text, InStr(text, "Cost Center: ") + 12, InStr(text, "Rejection Reason: ") - 2)
rReason = substring(text, InStr(text, "Rejection Reason: ") + 17, InStr(text, "Comments: ") - 2)
Cmts = substring(text, InStr(text, "Comments: ") + 8, InStr(text, "Please ") - 2)

createArrayOfProperties = Array(Eng, cName, Pos, Sup, jDate, Shift, Org, CostC, rReason, Cmts)

End Function

 

[ranman256]

LEFT needs LEFT (string, #)
Right(text, Len(text) - startIndex) may not evaluate to a string. Check the math.