VBA code working in Outlook 2010 but not in 2013

Hi All,

My vba code is working in outlook 2010 but not in outlook 2013 unfortunately. I hope one of you is able to help me. Please let me know if you need any more information.

The error starts at the following line of code:

         objItem = Mid(objItem, InStr(objItem, "#") + 1)

Below is the full code:

Private Sub CommandButton1_Click()
If ListBox1.Value = "" Then
Exit Sub
End If
If ListBox2.Value = "" Then
Exit Sub
End If

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim Inbehandeling As Outlook.Folder
Dim Events As Outlook.Folder
Dim objApp As Application
Dim strTicket, strSubject As String
Dim new_msg As MailItem
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set ns = Application.GetNamespace("MAPI")
Teamnaam = Me.ListBox1.Value
Werkstroom = Me.ListBox2.Value
'-------
'Controle of barcode er is
   ' Default value in case # is not found in the subject line
     strTicket = "None"
    
   ' Grab the subject from the message
        For Each objItem In Application.ActiveExplorer.Selection
            If objItem.Subject Like "*KlntVrzknr*" Then
                 objItem.Subject = objItem.Subject
            Else
                 objItem.Subject = objItem.Subject & "---KlntVrzknr#" & Format(Date, "yyyymmdd") & Format(Time, "hhmmss") & "#"
        End If
        
objItem.Categories = UserForm1.TextBox1.Text


'mail verplaatsen
Set Inbehandeling = myInbox.Folders("A. In behandeling")
objItem.Move Inbehandeling

   ' See if it has a hash symbol in it
          ' Trim off leading stuff up to and including the hash symbol
         objItem = Mid(objItem, InStr(objItem, "#") + 1)
        
   ' Now find the trailing space after the ticket number and chop it off after that
         If InStr(objItem, "#") > 0 Then
             strTicket = "PromiseIII_" & Left(objItem, InStr(objItem, "#") - 1)
         End If

'event aanmaken
     Set Events = myInbox.Folders("D. Events")
     Set Myitem = Application.CreateItem(olMailItem)
     Myitem.Subject = strTicket & ";" & "14;" & Format(Date, "yyyymmdd") & Format(Time, "hhmmss") & ";" & Teamnaam & ";" & Werkstroom & ";"
     Set myCopiedItem = Myitem.Copy
     
     myCopiedItem.Move Events

    
'--------wegschrijven event naar Access--------
 
 Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim NoOfRecords As Long
  'Open the .accdb form database to retrieve data
  Set db = OpenDatabase("\\Europe.Intranet\DFSNL\P\GD\014226\Applicaties\Mailbox\sourceAccess.accdb")
  'Define the first recordset
  Set rs = db.OpenRecordset("SELECT * FROM Events")
 
 
 ' open database
     Set db = OpenDatabase("\\Europe.Intranet\DFSNL\P\GD\014226\Applicaties\Mailbox\sourceAccess.accdb")
    ' open table as a recordset
    Set rs = db.OpenRecordset("SELECT * FROM Events")
    ' add a record to the recordset
    rs.AddNew
    ' fill fields with data ... in this case from cell A1
    rs.Fields("Events") = Myitem.Subject
    ' write back recordset to database
    rs.Update
    ' important! cleanup
    rs.Close
    ' forget to close the DB will leave the LDB lock file on the disk
    db.Close

    Set rs = Nothing
    Set db = Nothing
    
'----------

Unload UserForm1
MsgBox ("Verzoek in behandeling genomen")

Next
End Sub

Thanks in advance!

Thank you Norie for your quick reply.

I get the following error message:

Run-time error "438": Object doesn't support this property or method.

I don't have any items marked as missing.

In the beginning of the code I'm adding a unique number to the subject. for example the subject of the email was: "Welcome to excelforum" and the code changes it to : "Welcome to excelforum #memberid 2321".

At the code where the first error originates:

         objItem = Mid(objItem, InStr(objItem, "#") + 1)

I'm looking if this email already received a unique number. If it has the subject of the e-mail has an "#" sign.

If it doesnt have the "#" sign the position of the sign would be 0 and a new unique number is added. If it has a unique sign the number won't be added again.

If InStr(objItem, "#") > 0 Then
             strTicket = "PromiseIII_" & Left(objItem, InStr(objItem, "#") - 1)
         End If

I found a solution to my problem by just trying different things :D

I don't know if this is the cleanest solution, but hey it works!

I created an extra variable as a string, which I use to assign the position of the # sign instead of ObjItem which was from the type of Outlook.Mailitem.