I pretty much changed few variable names from my old code.
and i got "Run-time error '5': Invalid Procedure call or argument"
Im very new to this website, so please help me. I dont even kno how to make that Code box.
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
and i got "Run-time error '5': Invalid Procedure call or argument"
Im very new to this website, so please help me. I dont even kno how to make that Code box.
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
