Beste,
Ik heb een VBA code draaien voor het verplaatsen van emails naar mappen binnen outlook-bestand.
Echter krijg ik nu de volgende melding, voorheen werkte het feilloos.
De melding is "Fout 13 tijdens uitvoering: Typen komen niet met elkaar overeen"
De code die gebruik is:
Weet iemand wat er aan de hand is?
Ik heb een VBA code draaien voor het verplaatsen van emails naar mappen binnen outlook-bestand.
Echter krijg ik nu de volgende melding, voorheen werkte het feilloos.
De melding is "Fout 13 tijdens uitvoering: Typen komen niet met elkaar overeen"
De code die gebruik is:
Code:
Public Sub Archiveren()
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As MailItem
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim Folder1 As Outlook.Folder
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection
If obj.Categories = "SPIE" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("SPIE Nederland")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "RO" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("RO Samen sneller Op Bestemming")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "A15/N3 Strukton" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("A15/N3 Reconstructie Af- en toerit 23")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-04" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-04 Verplaatsen DS")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-15" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-15 VRI Horst")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-21" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-21 IM Camera's A2 en A27")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-23" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-23 VRI Leenderheide")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-25" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-25 VKS KP Ekkersrijt en Rotatiepaneel KP Vonderen")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-26" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-26 LED verlichting ZN")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-28" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-28 Filebeveiligingssysteem A58")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
If obj.Categories = "NO-V02" Then
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("NO-V02 Led A12")
Set Folder1 = myInbox.Folders("Ingaand")
obj.UnRead = False
obj.Move Folder1
End If
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
Set Folder1 = Nothing
End Sub
Weet iemand wat er aan de hand is?