Come copiare la struttura delle cartelle di Outlook sul desktop (esplora risorse)?
Come sapete, possiamo utilizzare la funzione Archivio per copiare la struttura delle cartelle in un altro Outlook, ma sapete come copiare la struttura delle cartelle di Outlook in una determinata cartella di Windows, come il desktop? Questo articolo introdurrà un VBA per copiare facilmente la struttura delle cartelle di Outlook nell'esplora risorse di Windows.
Copia la struttura delle cartelle di Outlook sul desktop (esplora risorse)
Copia la struttura delle cartelle di Outlook sul desktop (esplora risorse)
Si prega di seguire i passaggi seguenti per copiare la struttura delle cartelle di Outlook sul desktop o nell'esplora risorse.
1. Nel Riquadro di Navigazione, fare clic per evidenziare la cartella specifica la cui struttura si desidera copiare, e premere i tasti "Alt" + "F11" per aprire la finestra Microsoft Visual Basic for Applications.
2. Fare clic su "Strumenti" > "Riferimenti" per aprire la finestra di dialogo Riferimenti. Quindi, nella finestra di dialogo, selezionare l'opzione "Microsoft Scripting Runtime" e fare clic sul pulsante "OK". Vedere screenshot:
3. Fare clic su "Inserisci" > "Modulo", e copiare e incollare il seguente codice VBA nella nuova finestra del modulo.
VBA: Copia la struttura delle cartelle di Outlook nell'esplora risorse di 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. Premere il tasto "F5" o fare clic sul pulsante "Esegui" per eseguire questo VBA.
5. Nella finestra di dialogo "Sfoglia Cartella" che appare, selezionare la cartella specifica in cui si desidera inserire la struttura delle cartelle copiata e fare clic sul pulsante "OK". Vedere screenshot:
Ora andate nella cartella specificata, vedrete che la struttura delle cartelle è stata copiata sul disco rigido specificato. Vedere screenshot:
Nota: gli elementi della cartella, come email, appuntamenti, attività, ecc., vengono anch'essi copiati nelle cartelle corrispondenti sul disco rigido.
Articoli Correlati
Come copiare la struttura delle cartelle in un nuovo file di dati PST in Outlook?
I migliori strumenti per la produttività in Office
Ultime novità: Kutools per Outlook lancia la versione gratuita!
Scopri la nuovissima versione GRATUITA di Kutools per Outlook con oltre70 funzionalità straordinarie, da utilizzare PER SEMPRE! Clicca per scaricarla subito!
📧 Automazione Email: Risposta automatica (disponibile per POP e IMAP) / Programma invio email / CC/BCC automatico tramite regola durante l'invio / Inoltro automatico (Regola avanzata) / Aggiungi saluto automaticamente / Suddividi automaticamente le email con più destinatari in messaggi individuali...
📨 Gestione Email: Richiama Email / Blocca email di phishing per oggetto e altri criteri / Elimina email duplicate / Ricerca Avanzata / Organizza cartelle...
📁 Allegati Pro: Salva in blocco / Distacca in blocco / Comprimi in blocco / Salvataggio automatico / Distacca automaticamente / Auto Comprimi...
🌟 Magia dell'interfaccia: 😊Più emoji belle e originali / Notifiche per email importanti / Riduci Outlook a icona invece di chiuderlo...
👍 Funzioni rapide: Rispondi a Tutti con Allegati / Email anti-phishing / 🕘Mostra il fuso orario del mittente...
👩🏼🤝👩🏻 Contatti & Calendario: Aggiungi in blocco contatti dalle email selezionate / Dividi un gruppo di contatti in gruppi individuali / Rimuovi promemoria di compleanno...
