連絡先のサブフォルダーをエクスポート、インポートするスクリプト


コメントにて以下のようなご要望をいただきました。


連絡先をエクスポート・インポートするスクリプトを使用させていただいています。
コメントも読み解きながら色々試してみましたがうまくいかないためご教示ください。

やりたいこと:
連絡先\部署1、連絡先\部署2…という連絡先フォルダの中に個別の連絡先が入っています。
これを他者にフォルダ構造ごとエクスポート・インポートし共用したいと思っています。

現在
  連絡先\部署1、連絡先\部署2…を作る
連絡先直下に個別の連絡先を入れる
ところまではostを使った上記スクリプト利用でできています。
以下についてご教示いただきたく。

1.他者がインポートする前に元々入っていた連絡先\部署1、連絡先\部署2…をフォルダごと消す、
  もしくは中身を消した後に個別連絡先をインポートしたい。
  ただし他者が自分で作ったフォルダまでは消したくないので連絡先以下を全部消すのはNG。

2.作成された連絡先\部署1、連絡先\部署2…の中に個別の連絡先を自動で入れたい。
  自動で仕分けする方法はスクリプトに直接でも(この連絡先はこのフォルダに入れる…と記述)
外部ファイルを読みそのルールに従ってでも(csvファイルを読むなど)構わない。
  もしくはフォルダ構造ごとエクスポートする出来ないか。

3.できればvbsで。

以上、よろしくお願いします。



フォルダーの構造ごとエクスポート・インポートしたいのであれば、PST ファイルを使うと良いと思います。

以下は連絡先のサブフォルダー以下を階層構造を維持して PST の連絡先にエクスポートするスクリプトです。拡張子を .vbs として保存してください。

' ここをトリプルクリックでスクリプト全体を選択できます。
Option Explicit
Const PST_FILE = "c:\temp\Contacts.pst"
Const olStoreUnicode = 2
Const olFolderContacts = 10
Dim olkApp 'As Outlook.Application
Dim objStore 'As Store
Dim fldDestRoot 'As Folder
Dim fldDestContacts 'As Folder
Dim fldContacts 'As Folder
Dim fldSub 'As Folder
'
Set olkApp = CreateObject("Outlook.Application")
' PST の追加
olkApp.Session.AddStoreEx PST_FILE, olStoreUnicode
For Each objStore In olkApp.Session.Stores
    If objStore.FilePath = PST_FILE Then
        Set fldDestRoot = objStore.GetRootFolder()
        Set fldDestContacts = fldDestRoot.Folders.Add("連絡先", olFolderContacts)
        Exit For
    End If
Next
' 連絡先フォルダーの取得
Set fldContacts = olkApp.Session.GetDefaultFolder(olFolderContacts)
For Each fldSub in fldContacts.Folders
    ExportContactsOneFolder fldSub, fldDestContacts
Next
'
olkApp.Session.RemoveStore fldDestRoot
'
Sub ExportContactsOneFolder(fldContacts, fldDestParent)
    Dim fldDest 'As Folder
    Dim contSource 'As ContactItem
    Dim contDest 'As ContactItem
    ' 連絡先フォルダーを追加
    Set fldDest = fldDestParent.Folders.Add(fldContacts.Name, olFolderContacts)
    ' アイテムをコピー
    For Each contSource In fldContacts.Items
        Set contDest = contSource.Copy
        contDest.Move fldDest
    Next
    ' サブフォルダーがなければ以下の記述は不要
    Dim fldSub 'As Folder
    For Each fldSub in fldContacts.Folders
        ExportContactsOneFolder fldSub, fldDest
    Next
End Sub

そして、以下は上記によりエクスポートした PST から連絡先以下にインポートするスクリプトです。
インポートの際に同じ名前のフォルダーが存在する場合は中身を削除しますが、既定の連絡先フォルダーの内容や、PST にないフォルダーのアイテムは削除しません。

' ここをトリプルクリックでスクリプト全体を選択できます。
Option Explicit
Const PST_FILE = "c:\temp\Contacts.pst"
Const olStoreUnicode = 2
Const olFolderContacts = 10
Dim olkApp 'As Outlook.Application
Dim objStore 'As Store
Dim fldSourceRoot 'As Folder
Dim fldSourceContacts 'As Folder
Dim fldContacts 'As Folder
Dim fldSub 'As Folder
'
Set olkApp = CreateObject("Outlook.Application")
' PST の追加
olkApp.Session.AddStoreEx PST_FILE, olStoreUnicode
For Each objStore In olkApp.Session.Stores
    If objStore.FilePath = PST_FILE Then
        Set fldSourceRoot = objStore.GetRootFolder()
        Set fldSourceContacts = fldSourceRoot.Folders.Item("連絡先")
        Exit For
    End If
Next
' 連絡先フォルダーの取得
Set fldContacts = olkApp.Session.GetDefaultFolder(olFolderContacts)
For Each fldSub in fldSourceContacts.Folders
    ImportContactsOneFolder fldSub, fldContacts
Next
'
olkApp.Session.RemoveStore fldSourceRoot
'
Sub ImportContactsOneFolder(fldContacts, fldDestParent)
    Dim fldDest 'As Folder
    Dim contSource 'As ContactItem
    Dim contDest 'As ContactItem
    Dim i 'As Integer
    ' 連絡先フォルダーを取得
    On Error Resume Next
    Set fldDest = fldDestParent.Folders.Item(fldContacts.Name)
    If Err.Number <> 0 Then
        ' インポート先にフォルダーがなければ作成
        Set fldDest = fldDestParent.Folders.Add(fldContacts.Name, olFolderContacts)
    Else
        ' インポート先にフォルダーがあれば中身を消去
        For i = fldDest.Items.Count To 1 Step -1
            fldDest.Items.Remove i
        Next
    End If
    ' アイテムをコピー
    For Each contSource In fldContacts.Items
        Set contDest = contSource.Copy
        contDest.Move fldDest
    Next
    ' サブフォルダーがなければ以下の記述は不要
    Dim fldSub 'As Folder
    For Each fldSub in fldContacts.Folders
        ImportContactsOneFolder fldSub, fldDest
    Next
End Sub

 

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中