메인 컨텐츠로 가기

Outlook 폴더 구조를 데스크톱 (Windows 탐색기)에 복사하는 방법은 무엇입니까?

아시다시피 보관 기능을 적용하여 폴더 구조를 다른 Outlook에 복사 할 수 있지만 Outlook 폴더 구조를 바탕 화면과 같은 특정 창 폴더에 복사하는 방법을 알고 있습니까? 이 기사에서는 Outlook 폴더 구조를 Windows 탐색기에 쉽게 복사하는 VBA를 소개합니다.

Outlook 폴더 구조를 바탕 화면에 복사 (Windows 탐색기)

Office 탭 - Microsoft Office에서 탭 편집 및 탐색을 활성화하여 작업을 원활하게 만듭니다.
Outlook용 Kutools - 탁월한 효율성을 위한 100개 이상의 고급 기능으로 Outlook 향상
이러한 고급 기능으로 Outlook 2021~2010 또는 Outlook 365를 향상하세요. 포괄적인 60일 무료 평가판을 즐기고 이메일 경험을 향상시키십시오!

Outlook 폴더 구조를 바탕 화면에 복사 (Windows 탐색기)

Outlook 폴더 구조를 데스크톱 또는 Windows 탐색기에 복사하려면 아래 단계를 따르십시오.

1. 탐색 창에서 복사 할 폴더 구조가있는 지정된 폴더를 클릭하여 강조 표시하고 다른 + F11 키를 눌러 Microsoft Visual Basic for Applications 창을 엽니 다.

2. 클릭 도구 > 참조 참조 대화 상자를 엽니 다. 그런 다음 대화 상자에서 Microsoft 스크립팅 런타임 옵션을 클릭하고 OK 단추. 스크린 샷보기 :

3. 클릭 끼워 넣다 > 모듈을 클릭하고 VBA 코드 아래에 복사하여 새 모듈 창에 붙여 넣습니다.

VBA : Outlook 폴더 구조를 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. 프레스 F5 키를 누르거나 달리기 버튼을 눌러이 VBA를 실행합니다.

5. 폴더 찾아보기 대화 상자가 나타나면 복사한 폴더 구조를 배치할 지정된 폴더를 선택하고 OK 단추. 스크린 샷보기 :

이제 지정된 폴더로 이동하면 폴더 구조가 지정된 하드 디스크에 복사되는 것을 볼 수 있습니다. 스크린샷 보기:

주의 사항: 이메일, 약속, 작업 등과 같은 폴더 항목도 하드 디스크의 해당 폴더에 복사됩니다.


관련 기사


최고의 사무 생산성 도구

Outlook 용 Kutools - 귀하의 전망을 강화하는 100개 이상의 강력한 기능

📧 이메일 자동화: 부재중(POP 및 IMAP에서 사용 가능)  /  이메일 보내기 예약  /  이메일 발송 시 규칙에 따른 자동 참조/숨은참조  /  자동 전달(고급 규칙)   /  인사말 자동 추가   /  여러 수신자 이메일을 개별 메시지로 자동 분할 ...

📨 이메일 관리: 이메일을 쉽게 기억할 수 있습니다.  /  제목 및 기타 사기 이메일 차단  /  중복 이메일 삭제  /  고급 검색  /  폴더 통합 ...

📁 첨부 파일 프로일괄 저장  /  일괄 분리  /  일괄 압축  /  자동 저장   /  자동 분리  /  자동 압축 ...

🌟 인터페이스 매직: 😊더 예쁘고 멋진 이모티콘   /  탭 보기로 Outlook 생산성 향상  /  문을 닫는 대신 전망을 최소화하세요 ...

???? 원클릭 불가사의: 수신 첨부 파일과 함께 전체 회신  /   피싱 방지 이메일  /  🕘발신자의 시간대 표시 ...

👩🏼‍🤝‍👩🏻 연락처 및 캘린더: 선택한 이메일에서 연락처 일괄 추가  /  연락처 그룹을 개별 그룹으로 분할  /  생일 알림 제거 ...

이상 100 특징 당신의 탐험을 기다려주세요! 더 알아보려면 여기를 클릭하세요.

 

 

Comments (16)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello, that's brilliant! How can I adjust the code to only save email attachments, not the entire message? Many thanks
This comment was minimized by the moderator on the site
'This code solves the duplicate filename problemDim 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
This comment was minimized by the moderator on the site
Here is how i modified the code to make it work

i will paste it in reply
This comment was minimized by the moderator on the site
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
This comment was minimized by the moderator on the site
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?
This comment was minimized by the moderator on the site
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
This comment was minimized by the moderator on the site
What is this second piece of code? Do I use the original reply code or the second reply and that?
This comment was minimized by the moderator on the site
it is all 1 code, it was too long to post in 1 piece
This comment was minimized by the moderator on the site
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.
This comment was minimized by the moderator on the site
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
This comment was minimized by the moderator on the site
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 ?
This comment was minimized by the moderator on the site
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 lineFor 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 linexCount = 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
This comment was minimized by the moderator on the site
This is great, thank you! What would the code look like if I just want Inbox + all subfolders? (i.e., exclude deleted items?)Thank you!Morghan
This comment was minimized by the moderator on the site
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.
This comment was minimized by the moderator on the site
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?
This comment was minimized by the moderator on the site
Bonjour,

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

D'avance merci pour vos retours.

Cordialement,

Ando Rakotomalala
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations