Hey All,

This is my first post on this forum. I hope that someone will be able to help me. please let me know if you need any more information.

I'm having problems with a vba code in outlook. The code works fine in outlook 2010, but gives an error in outlook 2013.

I believe that it has something to do with the Microsoft Office Object Library

The code gives an error at the following part

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




Below is the complete 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