基本上有一個很笨的方式提供給您參考。
1.建立一個新的Outlook範本PST檔,裡面的結構您可以先照現有的樣式建立。
2.關閉該PST檔,並關閉Outlook後,將建立的PST檔複製一份標明"XX範本.PST"。
3.開啟Outlook,將原本的PST檔掛入使用,後面如果需要該樣式的PST檔時,複製 "XX範本.PST" 修改新的檔案名稱,再從Outlook掛入該PST檔使用即可。
缺點,沒辦法完全跟修改後的舊有一樣,不過應該可以省掉很多麻煩了。
沒有笨方法,只有適不適用^^
但我目前的情況不適用
因為各同仁的目錄結構並不統一,我沒辦法建標準範本來使用。
這有一篇討論Outlook VBA 資料夾結構的
http://blog.udn.com/WayCheng/3052766
但小弟能力不足,正在努力吸收,如有前輩能指點一下,不勝感激。
只要用封存的,就封存當天!
也許會有幾封信過到新的PST上,但把它再找回來就好了(手動搬回原來的PST就好啦)!
以上是這兩天寫著寫的VBA,初步執行是可以
但沒加上判斷已有建立相同目錄要跳出的條件
有需要的版友請自行取用
<pre class="c" name="code">
Sub MailFolder()
Dim myNameSpce As Outlook.NameSpace
Dim mySourFolder, myDestFolder As Outlook.MAPIFolder
Dim subFolder, thisFolder, thismyDestFolder As Outlook.MAPIFolder
Set myNameSpace = Application.GetNamespace("MAPI")
Set mySourFolder = myNameSpace.Folders("個人資料夾0").Folders("收件匣").Folders("1") '設定來源:個人資料夾0\收件匣\資料夾"物件
Set myDestFolder = myNameSpace.Folders("個人資料夾1").Folders("收件匣").Folders("1") '設定目標:個人資料夾1\收件匣\資料夾"物件
For i = 1 To mySourFolder.Folders.Count
Set thisFolder = mySourFolder.Folders(i)
myDestFolder.Folders.Add (thisFolder.Name)
Set thismyDestFolder = myDestFolder.Folders(thisFolder.Name)
If thisFolder.Folders.Count <> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
Set subFolder = subFolders(thisFolder, thismyDestFolder)
End If
Next i
End Sub
<pre class="c" name="code">
Function subFolders(ByVal mySourFolder As Outlook.MAPIFolder, myDestFolder As Outlook.MAPIFolder) As Outlook.MAPIFolder
Dim subFolder, thisFolder, thismyDestFolder As Outlook.MAPIFolder
For i = 1 To mySourFolder.Folders.Count
Set thisFolder = mySourFolder.Folders(i)
myDestFolder.Folders.Add (thisFolder.Name)
Set thismyDestFolder = myDestFolder.Folders(thisFolder.Name)
If thisFolder.Folders.Count <> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
Set subFolder = subFolders(thisFolder, thismyDestFolder)
End If
Next i
End Function