Kako brzo kopirati strukturu mape iz jedne Outlook PST datoteke u drugu putem VBA

Ako želite kopirati strukturu mape iz jedne Outlook PST datoteke u drugu, možete koristiti metodu predstavljenu u ovom članku, koja će vas naučiti kako koristiti VBA da biste je dobili u jednom potezu.

Možda ste, kako biste bolje upravljali svojom e-poštom, stvorili nekoliko prilagođenih mapa u svojoj glavnoj Outlook datoteci. Stoga kada stvarate novu Outlook PST datoteku, možda ćete htjeti primijeniti istu strukturu mape. Zapravo, u mom prethodnom članku – “2 koraka za zadržavanje trenutne hijerarhije mapa u novoj Outlook datoteci“, možete naučiti tradicionalnu metodu, koja koristi značajku „Arhiviraj” da to postigne. Ipak, zapravo je još uvijek pomalo zamoran. U usporedbi s njim, korištenje VBA kodova za njegovo dobivanje bit će mnogo brže. Stoga ćemo vam u nastavku reći razrađene korake i kodove.

Kopirajte strukturu mape iz jedne Outlook PST datoteke u drugu

1. Na samom početku pokrenite Outlook.
2. Zatim u prozoru programa Outlook pritisnite tipke "Alt + F11".
3. Zatim ćete ući u prozor uređivača Outlook VBA.
4. Nakon toga kopirajte i zalijepite sljedeće VBA kodove u novi modul.

Public objNewPSTFolder As Outlook.Folder
 
Sub CopyFolderStructure()
    Dim objFolders As Outlook.Folders
    Dim objFolder As Outlook.Folder
 
    'Get the folders of the source Outlook PST file
    Set objFolders = Outlook.Application.Session.Folders("Personal").Folders
 
    'Create the new pst file in your desired local folder and name
    Outlook.Application.Session.AddStore "E:\New PST File.pst"
    Set objNewPSTFolder = Session.Folders.GetLast()
 
    For Each objFolder In objFolders
        CreateFolder objFolder
    Next
 
    MsgBox "Completed!", vbOKOnly + vbInformation, "Copy Folder Structure"
End Sub
 
Sub CreateFolder(objFolder As Outlook.Folder)
    Dim objSubFolder As Outlook.Folder
 
    'Only copy the mail folder
    If (objFolder.DefaultItemType = olMailItem) Then
       'New Outlook PST file auto includes the "Deleted Items" folder, so skip it
       'Skip the useless mail folders - "Conversation Action Settings" and "Quick Step Settings"
       If (objFolder.Name <> "Deleted Items") And (objFolder.Name <> "Conversation Action Settings") And (objFolder.Name <> "Quick Step Settings") Then
 
          'Create the new folder
          objNewPSTFolder.Folders.Add objFolder.Name
          Set objNewPSTFolder = objNewPSTFolder.Folders.Item(objFolder.Name)
 
          For Each objSubFolder In objFolder.Folders
              CreateFolder objSubFolder
          Next
 
          Set objNewPSTFolder = objNewPSTFolder.parent
       End If
    End If

End Sub

5. Nakon toga promijenite razinu sigurnosti makroa na nisku.
6. Kasnije se vratite u prozor uređivača VBA i pritisnite tipku "F5" za pokretanje makronaredbe.
7. Na kraju, nakon što makronaredba završi s radom, dobit ćete poruku "Dovršeno!".
8. U ovom trenutku možete otići do navigacijskog okna pošte. Vidjet ćete novu podatkovnu datoteku programa Outlook koja je u istoj strukturi mape kao izvorna PST datoteka, kao na slici ispod:

Nosite se s obeshrabrujućim PST problemima

Budući da je Outlook PST sklon pogreškama, mnogi od vas sigurno su se ikada susreli s raznim problemima u Outlooku. Suočeni s njima, prvo možete isprobati alat za popravak pristigle pošte programa Outlook. Ako ne uspije, možete primijeniti moćniji alat treće strane, kao što je DataNumen Outlook Repair, koji može popraviti Outlook PST pogreške kao povjetarac.

Uvod za autora:

Shirley Zhang stručnjakinja je za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući SQL Server popraviti i softverske proizvode za popravak Outlooka. Za više informacija posjetite www.datanumen.com