複製 Outlook 資料夾結構

微軟 vba oulook

wnchn 2012-01-06 12:47:27 ‧ 14008 瀏覽

分享至

想請教板上前輩
有沒什麼方法可以將Outlook 2003的資料夾結構，複製到新建的郵件資料夾去。
想請教板上前輩
有沒什麼方法可以將Outlook 2003的資料夾結構，複製到新建的郵件資料夾去。
例如
使用者有一個2011.pst的郵件資料夾，裡面建了
A
--AA
B
--BA
--BB
現在又開了一個2012.pst的郵件資料夾，
有沒什麼方式可以複製2011.pst的資料夾結構過來，但不複製裡面的郵件呢？

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

4 則留言

shadowpeople

iT邦新手 1 級 ‧ 2012-01-06 14:37:57

基本上有一個很笨的方式提供給您參考。
1.建立一個新的Outlook範本PST檔，裡面的結構您可以先照現有的樣式建立。
2.關閉該PST檔，並關閉Outlook後，將建立的PST檔複製一份標明"XX範本.PST"。
3.開啟Outlook，將原本的PST檔掛入使用，後面如果需要該樣式的PST檔時，複製 "XX範本.PST" 修改新的檔案名稱，再從Outlook掛入該PST檔使用即可。

缺點，沒辦法完全跟修改後的舊有一樣，不過應該可以省掉很多麻煩了。

回應
檢舉

登入發表回應

wnchn

iT邦新手 4 級 ‧ 2012-01-06 16:04:05

沒有笨方法，只有適不適用^^
但我目前的情況不適用
因為各同仁的目錄結構並不統一，我沒辦法建標準範本來使用。
這有一篇討論Outlook VBA 資料夾結構的
http://blog.udn.com/WayCheng/3052766
但小弟能力不足，正在努力吸收，如有前輩能指點一下，不勝感激。

回應
檢舉

登入發表回應

samworks4u

iT邦新手 2 級 ‧ 2012-01-06 17:59:33

只要用封存的，就封存當天！
也許會有幾封信過到新的PST上，但把它再找回來就好了(手動搬回原來的PST就好啦)！

回應
檢舉

登入發表回應

wnchn

iT邦新手 4 級 ‧ 2012-01-11 18:23:11

以上是這兩天寫著寫的VBA，初步執行是可以
但沒加上判斷已有建立相同目錄要跳出的條件
有需要的版友請自行取用

&lt;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 &lt;> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
        Set subFolder = subFolders(thisFolder, thismyDestFolder)
    End If
Next i
    
End Sub

回應 1
檢舉

wnchn iT邦新手 4 級 ‧ 2012-01-11 18:23:33 檢舉

&lt;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 &lt;> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
        Set subFolder = subFolders(thisFolder, thismyDestFolder)
    End If
Next i

End Function

登入發表回應