Note: The other languages of the website are Google-translated. Back to English
Mewngofnodi  \/ 
x
or
x
Cofrestru  \/ 
x

or

Sut i gopïo strwythur ffolder Outlook i'r bwrdd gwaith (windows explorer)?

Fel y gwyddoch, gallwn gymhwyso'r nodwedd Archif i gopïo strwythur ffolder i Outlook arall, ond a ydych chi'n gwybod sut i gopïo strwythur ffolder Outlook i ffolder ffenestr benodol, fel bwrdd gwaith? Bydd yr erthygl hon yn cyflwyno VBA i gopïo strwythur ffolder Outlook i archwiliwr windows yn hawdd.

Copïwch strwythur ffolder Outlook i'r bwrdd gwaith (windows explorer)

Tab Swyddfa - Galluogi Golygu a Phori Tabbed yn y Swyddfa, a Gwneud Gwaith yn Haws Orau ...
Kutools for Outlook - Yn Dod â 100 o Nodweddion Uwch Pwerus i Microsoft Outlook
  • Auto CC / BCC yn ôl rheolau wrth anfon e-bost; Auto Ymlaen E-byst Lluosog yn ôl rheolau; Ymateb Auto heb weinydd cyfnewid, a nodweddion mwy awtomatig ...
  • Rhybudd BCC - dangos neges pan geisiwch ateb popeth os yw'ch cyfeiriad post yn rhestr BCC; Atgoffwch Wrth Ymlyniadau ar Goll, a mwy o nodweddion atgoffa ...
  • Ymateb (Pawb) Gyda'r Holl Atodiadau yn y sgwrs bost; Ateb Llawer o E-byst ar unwaith; Auto Ychwanegu Cyfarchiad wrth ateb; Auto Ychwanegu Dyddiad ac Amser yn destun ...
  • Offer Ymlyniad: Auto Detach, Cywasgu Pawb, Ail-enwi Pawb, Auto Save All ... Adroddiad Cyflym, Cyfrif Postiau Dethol, Tynnwch y Post a Chysylltiadau Dyblyg ...
  • Bydd mwy na 100 o nodweddion datblygedig datrys y rhan fwyaf o'ch problemau yn Outlook 2010-2019 a 365. Nodweddion llawn treial am ddim 60 diwrnod.

Copïwch strwythur ffolder Outlook i'r bwrdd gwaith (windows explorer)

Dilynwch y camau isod i gopïo strwythur ffolder Outlook i'r bwrdd gwaith neu'r archwiliwr ffenestri.

1. Ar y Pane Llywio, cliciwch i dynnu sylw at y ffolder penodedig y byddwch chi'n copïo strwythur ei ffolder, a'i wasgu Alt + F11 allweddi i agor ffenestr Microsoft Visual Basic for Applications.

2. Cliciwch offer > cyfeiriadau i agor y blwch deialog Cyfeiriadau. Yna yn y blwch deialog gwiriwch y Microsoft Scripting Runtime opsiwn, a chliciwch ar y OK botwm. Gweler y screenshot:

3. Cliciwch Mewnosod > Modiwlau, a chopïo a gludo islaw cod VBA i mewn i ffenestr y modiwl newydd.

VBA: Copïwch strwythur ffolder Outlook i archwiliwr 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. Gwasgwch F5 allwedd neu cliciwch y Run botwm i redeg y VBA hwn.

5. Yn y blwch deialog Pori Am Ffolder, dewiswch y ffolder penodedig y byddwch chi'n gosod strwythur y ffolder wedi'i gopïo, a chliciwch ar y OK botwm. Gweler y screenshot:

Nawr ewch i'r ffolder penodedig, fe welwch fod strwythur y ffolder yn cael ei gopïo i'r ddisg galed benodol. Gweler y screenshot:

Nodyn: mae eitemau'r ffolder, fel e-byst, apwyntiadau, tasgau, ac ati hefyd yn cael eu copïo i ffolderau cyfatebol yn y ddisg galed.


Erthyglau Perthnasol


Kutools for Outlook - Yn Dod â 100 o Nodweddion Uwch i'w Rhagweld, a Gwneud Gwaith yn Haws Osgach!

  • Auto CC / BCC yn ôl rheolau wrth anfon e-bost; Auto Ymlaen E-byst Lluosog yn ôl arfer; Ymateb Auto heb weinydd cyfnewid, a nodweddion mwy awtomatig ...
  • Rhybudd BCC - dangoswch neges pan geisiwch ateb popeth os yw'ch cyfeiriad post yn rhestr BCC; Atgoffwch Wrth Ymlyniadau ar Goll, a mwy o nodweddion atgoffa ...
  • Ymateb (Pawb) Gyda'r Holl Atodiadau yn y sgwrs bost; Ateb Llawer o E-byst mewn eiliadau; Auto Ychwanegu Cyfarchiad wrth ateb; Ychwanegu Dyddiad i'r pwnc ...
  • Offer Ymlyniad: Rheoli Pob Atodiad ym mhob Post, Datgysylltiad Auto, Cywasgu Pawb, Ail-enwi Pawb, Arbed Pawb ... Adroddiad Cyflym, Cyfrif Postiau Dethol...
  • E-byst Sothach Pwerus yn ôl arfer; Tynnwch y Post a Chysylltiadau Dyblyg... Yn eich galluogi i wneud yn ddoethach, yn gyflymach ac yn well yn Outlook.
tab kutools rhagweld kutools tab 1180x121
kutools rhagweld rhagolygon kutools ynghyd â thab 1180x121
 
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Coco · 6 months ago
    Hello, that's brilliant! How can I adjust the code to only save email attachments, not the entire message? Many thanks
  • To post as a guest, your comment is unpublished.
    User2 · 1 years ago
    'This code solves the duplicate filename problem
    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

    xCount = 0

    For Each xItem In OutlookFolder.Items
    xSubject = ReplaceInvalidCharacters(xItem.Subject)
    xFilename = xSubject & ".msg"
    xFilePath = xPath & "\" & xFilename
    If xFSO.FileExists(xFilePath) Then
    xCount = xCount + 1
    xFilename = xSubject & " (" & xCount & ").msg"
    xFilePath = xPath & "\" & xFilename
    While xFSO.FileExists(xFilePath)
    xCount = xCount + 1
    xFilename = xSubject & " (" & xCount & ").msg"
    xFilePath = xPath & "\" & xFilename
    Wend
    End If
    xItem.SaveAs xFilePath, olMSG
    xCount = 0
    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
  • To post as a guest, your comment is unpublished.
    SamTheCnt · 1 years ago
    Here is how i modified the code to make it work

    i will paste it in reply
    • To post as a guest, your comment is unpublished.
      SamTheCnt · 1 years ago
      Dim xFSO As Scripting.FileSystemObject
      Sub CopyOutlookFldStructureToWinExplorer()
      ExportAction "Copy"
      msg = MsgBox("Copy of your Inbox is successful", vbOKOnly, "Done")
      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 * 100

      Dim xCounter As Integer
      Dim xFilename As String
      Dim xFileDateRec As String

      On Error Resume Next
      xPath = xFldPath & "\" & ReplaceInvalidCharacters(OutlookFolder.Name)

      If Dir(xPath, 16) = Empty Then MkDir xPath
      xCounter = 0

      For Each xItem In OutlookFolder.Items
      xCounter = xCounter + 1
      xSubject = ReplaceInvalidCharacters(xItem.Subject)
      xFileDateRec = xItem.ReceivedTime
      xFilename = ReplaceInvalidCharacters(RTrim(xSubject) & xFileDateRec & " " & xCounter & ".msg")
      xFilePath = xPath & "\" & xFilename
      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
      • To post as a guest, your comment is unpublished.
        Adam · 1 years ago
        If I re-run this VBA every couple months, does it only copy new email or does it copy new email and create duplicates for all existing emails?

      • To post as a guest, your comment is unpublished.
        SamTheCnt · 1 years ago
        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
        • To post as a guest, your comment is unpublished.
          ADam MIllar · 1 years ago
          What is this second piece of code? Do I use the original reply code or the second reply and that?

          • To post as a guest, your comment is unpublished.
            Sam · 1 years ago
            it is all 1 code, it was too long to post in 1 piece
  • To post as a guest, your comment is unpublished.
    acoli · 2 years ago
    hello, same thing. you code works great.. the only thing is that the duplicate names, more than (1), are not exported.
    Please add the option.
  • To post as a guest, your comment is unpublished.
    Romen · 2 years ago
    Yes! the same as Ammar asked, can you modify the code so it copies every item even if it has the same name!!! this would help me a lot
  • To post as a guest, your comment is unpublished.
    Ammar · 2 years ago
    Hello I have one question, I used the above mentioned code, but it is missing the related conversations as it has the same subject. This is created problem as the numbers of items in outlook not matching with number of items in folder. Can you please help to edit the above code so that it also paste all the items even though it has same subject ?
    • To post as a guest, your comment is unpublished.
      User · 1 years ago
      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
      xCount = 0 ' Pasted line
      For Each xItem In OutlookFolder.Items
      xSubject = ReplaceInvalidCharacters(xItem.Subject)
      xFilename = xSubject & ".msg"
      ' Deleted line xCount = 0
      xFilePath = xPath & "\" & xFilename
      If xFSO.FileExists(xFilePath) Then
      xCount = xCount + 1
      xFilename = xSubject & " (" & xCount & ").msg"
      xFilePath = xPath & "\" & xFilename
      Else ' New line
      xCount = 0 ' New line
      E
      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
  • To post as a guest, your comment is unpublished.
    Kristian · 2 years ago
    It works (sort of), but (a) there were more messages exported to one folder than were in the corresponding Outlook Folder and (b) there were fewer messages exported to one folder than were in the Outlook Folder and (c) (not 100% sure) I think one message went to the wrong folder.
  • To post as a guest, your comment is unpublished.
    Amy · 3 years ago
    I have Outlook 15, and the macro won't replace the "/" where used in Outlook folder names. It just skips those folders. Is this a compatibility issue?
  • To post as a guest, your comment is unpublished.
    and.infini@gmail.com · 3 years ago
    Bonjour,

    Serait-il possible de stocker les mails dans un fichier .pst ?

    D'avance merci pour vos retours.

    Cordialement,

    Ando Rakotomalala