Comment copier la structure du dossier Outlook sur le bureau (Explorateur Windows)?
Comme vous le savez, nous pouvons appliquer la fonctionnalité d'archivage pour copier la structure de dossiers dans un autre Outlook, mais savez-vous comment copier la structure de dossiers Outlook dans un certain dossier de fenêtre, tel que le bureau? Cet article présentera un VBA pour copier facilement la structure des dossiers Outlook dans l'explorateur Windows.
Copier la structure du dossier Outlook sur le bureau (explorateur Windows)
Copier la structure du dossier Outlook sur le bureau (explorateur Windows)
Veuillez suivre les étapes ci-dessous pour copier la structure des dossiers Outlook sur le bureau ou l'explorateur Windows.
1. Sur le volet de navigation, cliquez pour mettre en surbrillance le dossier spécifié dont vous allez copier la structure de dossiers, puis appuyez sur autre + F11 touches pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.
2. Cliquez Outils > Références pour ouvrir la boîte de dialogue Références. Ensuite, dans la boîte de dialogue, cochez la case Exécution de scripts Microsoft option, et cliquez sur le OK bouton. Voir la capture d'écran:
3. Cliquez insérer > Module, et copiez et collez ci-dessous le code VBA dans la nouvelle fenêtre de module.
VBA: Copiez la structure du dossier Outlook dans l'explorateur Windows
Dim xFSO As Scripting.FileSystemObject
Sub CopyOutlookFldStructureToWinExplorer()
ExportAction "Copy"
End Sub
Sub ExportAction(xAction As String)
Dim xFolder As Outlook.Folder
Dim xFldPath As String
xFldPath = SelectAFolder()
If xFldPath = "" Then
MsgBox "You did not select a folder. Export cancelled.", vbInformation + vbOKOnly, "Kutools for Outlook"
Else
Set xFSO = New Scripting.FileSystemObject
Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
ExportOutlookFolder xFolder, xFldPath
End If
Set xFolder = Nothing
Set xFSO = Nothing
End Sub
Sub ExportOutlookFolder(ByVal OutlookFolder As Outlook.Folder, xFldPath As String)
Dim xSubFld As Outlook.Folder
Dim xItem As Object
Dim xPath As String
Dim xFilePath As String
Dim xSubject As String
Dim xCount As Integer
Dim xFilename As String
On Error Resume Next
xPath = xFldPath & "\" & OutlookFolder.Name
'?????????,??????
If Dir(xPath, 16) = Empty Then MkDir xPath
For Each xItem In OutlookFolder.Items
xSubject = ReplaceInvalidCharacters(xItem.Subject)
xFilename = xSubject & ".msg"
xCount = 0
xFilePath = xPath & "\" & xFilename
If xFSO.FileExists(xFilePath) Then
xCount = xCount + 1
xFilename = xSubject & " (" & xCount & ").msg"
xFilePath = xPath & "\" & xFilename
End If
xItem.SaveAs xFilePath, olMSG
Next
For Each xSubFld In OutlookFolder.Folders
ExportOutlookFolder xSubFld, xPath
Next
Set OutlookFolder = Nothing
Set xItem = Nothing
End Sub
Function SelectAFolder() As String
Dim xSelFolder As Object
Dim xShell As Object
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xSelFolder = xShell.BrowseForFolder(0, "Select a folder", 0, 0)
If Not TypeName(xSelFolder) = "Nothing" Then
SelectAFolder = xSelFolder.self.Path
End If
Set xSelFolder = Nothing
Set xShell = Nothing
End Function
Function ReplaceInvalidCharacters(Str As String) As String
Dim xRegEx
Set xRegEx = CreateObject("vbscript.regexp")
xRegEx.Global = True
xRegEx.IgnoreCase = False
xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
ReplaceInvalidCharacters = xRegEx.Replace(Str, "")
End Function
4. presse F5 ou cliquez sur la Courir bouton pour exécuter ce VBA.
5. Dans la boîte de dialogue Rechercher un dossier, sélectionnez le dossier spécifié dans lequel vous placerez la structure de dossiers copiée, puis cliquez sur le bouton OK bouton. Voir la capture d'écran:
Maintenant, allez dans le dossier spécifié, vous verrez que la structure du dossier est copiée sur le disque dur spécifié. Voir la capture d'écran:
Notes: les éléments du dossier, tels que les e-mails, les rendez-vous, les tâches, etc. sont également copiés dans les dossiers correspondants du disque dur.
Articles Relatifs
Comment copier la structure de dossiers dans un nouveau fichier de données pst dans Outlook?
Meilleurs outils de productivité bureautique
Dernières nouvelles : lancement de Kutools pour Outlook Version gratuite!
Découvrez le tout nouveau Kutools pour Outlook Version GRATUITE avec plus de 70 fonctionnalités incroyables, à utiliser POUR TOUJOURS! Cliquez pour télécharger maintenant!
📧 Email Automation: Réponse automatique (disponible pour POP et IMAP) / Programmer l'envoi d'e-mails / Auto CC/BCC par règles lors de l'envoi d'un e-mail / Transfert automatique (règles avancées) / Ajouter un message d'accueil automatique / Divisez automatiquement les e-mails multi-destinataires en messages individuels
(I.e. Email Management: Rappel des e-mails / Bloquer les e-mails frauduleux par sujets et autres / Supprimer les e-mails en double / Recherche Avancée / Consolider les dossiers
(I.e. Pièces jointes Pro: Sauvegarde par lots / Détachement par lots / Compression par lots / Enregistrement automatique / Détachement automatique / Compression automatique
???? Magie de l'interface: 😊Plus d'émojis jolis et cool / Vous rappeler lorsque des e-mails importants arrivent / Réduire Outlook au lieu de fermer
???? Merveilles en un clic: Répondre à tous avec les pièces jointes entrantes / E-mails anti-hameçonnage / 🕘Afficher le fuseau horaire de l'expéditeur
👩🏼🤝👩🏻 Contacts et calendrier: Ajouter par lots des contacts à partir des e-mails sélectionnés / Diviser un groupe de contacts en groupes individuels / Supprimer les rappels d'anniversaire
