iT邦幫忙

3

複製 Outlook 資料夾 結構

wnchn 2012-01-06 12:47:2713932 瀏覽
  • 分享至 

  • xImage
  •  

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


圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中
0
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檔使用即可。

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

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

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

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

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

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

以上是這兩天寫著寫的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
wnchn iT邦新手 4 級 ‧ 2012-01-11 18:23:33 檢舉
<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

我要留言

立即登入留言