Дневник megavtogal.com

МЕНЮ
  • Контакты
  • Статьи

Outlook скопировать структуру папок

Обновлено: 07.01.2025

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"
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

Here is how i modified the code to make it work

i will paste it in reply

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

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?

Иногда при работе с Outlook необходимо создать новый (пустой) файл данных Outlook PST, но сохранить текущую структуру папок Outlook из старого файла данных Outlook PST. Это полезно, особенно если текущий файл Outlook слишком велик по размеру и у вас возникают проблемы при работе или управлении им, и вы хотите создать новый файл PST с существующей (текущей) структурой папок.

В этом руководстве я покажу вам, как скопировать только структуру папок Outlook (без электронных писем) в новый файл данных Outlook PST. В конце процесса вы сможете использовать новый файл данных Outlook в качестве расположения хранилища по умолчанию для ваших электронных писем, календаря и контактов.

Как перенести структуру папок Outlook в новый файл данных Outlook.

Шаг 1. Создайте новый файл Outlook PST с помощью команды Архив.

Чтобы скопировать существующую структуру папок из текущего файла Outlook PST в новый (пустой) файл данных Outlook, необходимо создать новый файл Outlook PST с помощью функции «Архивировать» в Outlook. Для этого:

1. Откройте Outlook и перейдите к:

скопировать структуру папок outlook

2. В Варианты архива, примените следующие настройки:

1. Выберите для Архивировать эту папку и все подпапки.
2. Выбрать Личные папки.
3. Укажите дату, далекую от прошлого чтобы убедиться, что никакие письма не перемещаются в новый файл PST. (например, 01.01.1950)
4. Затем нажмите Просматривать кнопка.

образ

5. Введите узнаваемое имя для нового файла данных Outlook (например, «OutlookNew.pst») и нажмите хорошо.*

* Примечание: в конце процесса этот файл будет местом хранения по умолчанию для Outlook.

образ

6. щелчок хорошо еще раз, чтобы начать процесс архивирования.

образ

7. Когда процесс архивирования завершится, вы увидите в группе «Архивные папки» тот же список папок, что у вас уже есть в группе «Личные папки». *

перенести структуру папок outlook

8. Закрыть Outlook и перейдите к следующему шагу.

Шаг 2. Установите новый файл PST в качестве хранилища по умолчанию для Outlook.

1. Перейдите к панели управления Windows и установите Просмотр по: в Маленькие иконки.

2. открыто Почта (32-битная).

параметры почты

3. щелчок Дата файлы…

образ

4. Двойной клик на Личные папки.

образ

образ

образ

образ

9. Нажмите близко дважды, чтобы закрыть все окна.

образ

10. Запустите Outlook.
11. Вы сделали! С этого момента все ваши новые письма, контакты, календарь и задачи будут храниться в группе «Личные папки», которая представляет собой новый пустой файл PST (например, «OutlookNew.pst») и вашу существующую информацию в Outlook (письма, контакты, календарь, задачи) можно найти в группе «Личные папки», которая является старым PST-файлом (например, «Outlook.pst»).

Это оно! Дайте мне знать, если это руководство помогло вам, оставив свой комментарий о вашем опыте. Пожалуйста, любите и делитесь этим руководством, чтобы помочь другим.

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"
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

Here is how i modified the code to make it work

i will paste it in reply

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

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?

Как вы знаете, мы можем применить функцию архивации для копирования структуры папок в другой Outlook, но знаете ли вы, как скопировать структуру папок Outlook в определенную папку окна, например, на рабочий стол? В этой статье будет представлен VBA для простого копирования структуры папок Outlook в проводник Windows.

Копирование структуры папок Outlook на рабочий стол (проводник Windows)

Подробнее Загрузить

Скопируйте структуру папок Outlook на рабочий стол (проводник Windows).

Чтобы скопировать структуру папок Outlook на рабочий стол или в проводник Windows, выполните следующие действия.


1. В области навигации щелкните, чтобы выделить указанную папку, структуру папок которой вы скопируете, и нажмите клавиши Alt + F11 , чтобы открыть Microsoft Visual Basic для Окно приложений.


2. Нажмите Инструменты > Ссылки , чтобы открыть диалоговое окно «Ссылки». Затем в диалоговом окне установите флажок Microsoft Scripting Runtime и нажмите кнопку OK . См. Снимок экрана:

3. Нажмите Вставить > Module , скопируйте и вставьте ниже код VBA в новое окно модуля.

VBA: скопируйте структуру папок Outlook в проводник Windows

4. Нажмите клавишу F5 или кнопку Выполнить , чтобы запустить этот VBA.


5. В появившемся диалоговом окне «Обзор папок» выберите указанную папку, в которую вы поместите скопированную структуру папок, и нажмите кнопку OK .. Смотрите снимок экрана:


Теперь перейдите в указанную папку, вы увидите папку структура копируется на указанный жесткий диск. См. Снимок экрана:

Примечание : элементы папок, такие как электронные письма, встречи, задачи и т. д., также копируются в соответствующие папки на жестком диске.

Некоторые пользователи Outlook обычно используют особую структуру папок для повседневной работы с файлом данных pst. Но долгое время использования старого файла данных он станет громоздким в вашем Outlook. Фактически, вы можете начать с нового файла данных pst с той же структурой папок, что и старый файл данных pst в Outlook. В Outlook вы можете скопировать структуру папок в новый файл данных pst с помощью функции архивирования. Пожалуйста, просмотрите приведенное ниже руководство для получения более подробной информации.

Копировать структуру папок в новый файл данных pst в Outlook

Подробнее Загрузить


Скопировать структуру папок в новый файл данных PST в OutlookM

В Outlook вы можете использовать функцию архивации для создания нового файла даты PST с той же структурой папок, что и в Outlook. Старый. Пожалуйста, сделайте следующее.

1. Откройте диалоговое окно Архив .

1). В Outlook 2010 и 2013 нажмите Файл > Информация > Инструменты очистки > Архив . См. Снимок экрана:


2). В Outlook 2007 нажмите Файл > Архив .


2. В диалоговом окне Архив сделайте следующее.

1). Выберите вариант Архивировать эту папку и все подпапки ;

2). Выберите корень папок, в который вы хотите скопировать структуру папок на его основе;

3). В поле Архивировать элементы старше укажите прошедшую дату, когда электронные письма не будут перемещены.. Например, если самое старое электронное письмо в вашей почтовой папке было сохранено на 01.02.2013, вы можете установить элементы архива старше, чем ящик, как 01.01.2013;



5. Затем Outlook начинает архивирование.


6. После архивирования новый файл данных pst Archive отображается в области навигации с той же структурой папок, что и указанная выше.


7. Теперь вам нужно войти в диалоговое окно Настройки учетной записи , чтобы переименовать этот файл данных.

1). В Outlook 2010 и 2013 нажмите Файл > Информация > Настройки учетной записи > Настройки учетной записи .


2). В Outlook 2007 нажмите Инструменты > Настройки учетной записи .


8. В диалоговом окне Настройки учетной записи перейдите на вкладку Файлы данных , выберите файл данных Archives , который вы только что создали теперь в поле и нажмите кнопку Настройки . См. Снимок экрана:


9. В диалоговом окне Файл данных Outlook переименуйте файл данных в поле Имя , затем нажмите кнопку ОК .

Читайте также:

      
  • Лошадь в конан эксель где найти
    •   
  • Ревизия интерфейса ккт 1с что это
    •   
  • Как установить odbc драйвер для oracle
    •   
  • Как получить свойство в запросе 1с
    •   
  • Kyocera print center программа для сканирования
  • Контакты
  • Политика конфиденциальности