Créer MAPIFolder en PST en utilisant VBA
-
09-10-2019 - |
Question
Je suis en train de copier une structure de dossiers et sous-dossiers d'un Outlook PST à un autre et ont des difficultés avec l'instruction Folders.Add()
:
Private Sub Process(S As MAPIFolder, T As MAPIFolder, RootLevel As Boolean, BeforeDate As Date)
Dim N As NameSpace, F As MAPIFolder, G As MAPIFolder
' S is source folder (parameter)
' T is target folder (parameter)
' F is current source subfolder for recursion (private)
' G is target folder for recursion (private)
Set N = Application.GetNamespace("MAPI")
' recurse through subfolders
For Each F In S.Folders
If F.Items.Count <> 0 Or F.Folders.Count <> 0 Then ' process only if items or subfolders found
If FoundFolder(T, F) Then ' this function works fine
Set G = T.Folders(F.Name) ' found - just assign
Else
Set G = T.Folders.Add(F.Name, N.GetDefaultFolder(F.DefaultItemType)) ' not found - create
End If
'
' more code (working well)
'
' process next level without Root flag
Process F, G, False, BeforeDate
End If
Next F
Set F = Nothing
Set G = Nothing
End Sub
Tant que dans la déclaration de Folders.Add()
Je ne précise pas le paramètre Type
du tout, un dossier avec DefaultType olMailItem est créé (parce que mon dossier racine se trouve être un dossier de courrier). Cependant, je veux créer un dossier de même type que le dossier source.
1ère observation particulière:
- Aide VBA, MSN et d'autres disent que pour le type Folders.Add (Nom, Type) est en option longue.
- éditeur VBA dit (en infobulle lorsque taper) Type est MAPIFolder
2ème observation: Cependant, je tente de définir l'argument de type, je reçois une erreur
Erreur -2147024809 (80070057)
Impossible de terminer l'opération. Une ou plusieurs valeurs de paramètres ne sont pas valides
J'ai essayé le suivant
' Type as Long
Set G = T.Folders.Add(F.Name, 0)
Set G = T.Folders.Add(F.Name, olMailItem)
Set G = T.Folders.Add(F.Name, OlItemType.olMailItem)
Set G = T.Folders.Add(F.Name, F.DefaultItemType) ' this is what I actually want
' Type as MAPIFolder
Set G = T.Folders.Add(F.Name, F)
Set G = T.Folders.Add(F.Name, N.GetDefaultFolder(F.DefaultItemType))
Erreur - Erreur - Erreur
Que faire pour créer un dossier du même type que le dossier source F
Aide Tout le monde .... s'il vous plaît
kind regards MikeD
La solution
OK résolu .... problème était que je simplement utilisé le mauvais énumération : - (
La fonction création d'un dossier MAPI de type similaire à Source
ci-dessous un look de Target
donné comme ceci:
Private Function CreateFolderOfType(Source As MAPIFolder, Target As MAPIFolder) As MAPIFolder
Dim F As MAPIFolder
Set CreateFolderOfType = Nothing
' if source already exists below Target
For Each F In Target.Folders
If F.Name = Source.Name Then
Set CreateFolderOfType = F
Exit Function
End If
Next F
Select Case Source.DefaultItemType
Case olAppointmentItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderCalendar)
Case olContactItem, olDistributionListItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderContacts)
Case olJournalItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderJournal)
Case olMailItem, olPostItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderInbox)
Case olNoteItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderNotes)
Case olTaskItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderTasks)
Case Else
Set CreateFolderOfType = Target.Folders.Add(Source.Name)
End Select
End Function