連絡先をエクスポート・インポートするスクリプト


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


学校のパソコン教室でPCが40台あって、それぞれがoutlook2013を使ってメールを送受信します。アドレス帳を40台のPCで、共有したいと思っています。サンプルのアドレス帳の一覧データをCSVファイルでエクスポートして、LAN上の指定された共有フォルダに保存しておいて、他のPCは、ワンタッチでマクロでそのアドレス帳のデータを自動的にインポートするマクロを作りたいと思っています。なにせ、マクロは全くの初心者なので、どうすれば良いのか教えていただけますでしょうか?よろしくお願いします。


データを CSV にエクスポートするということなのですが、アドレス帳のデータを CSV にしようとするとフィールドの数が多くちょっと面倒です。
ほかのアプリケーションから取り込むのではなく Outlook で取り込むということであれば、PST ファイルのほうが手間もかからず損失するデータもないので良いでしょう。

また、マクロの場合すべての PC でマクロを記述する必要があるのですが、これもまた面倒なのでスクリプトを使うほうが良いと思います。

以下は、連絡先のすべてのアイテムを C:\temp\export.pst の「連絡先」というフォルダーにエクスポートするスクリプトです。
このコードをメモ帳などで拡張子を .vbs として保存し、ベースとなるアドレスデータを持つ PC で実行します。(.vbs のファイルはダブルクリックで実行できます。)
ファイル名を変更したい場合は "PST_FILE=" として設定しているファイル名を変更してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Const PST_FILE = "c:\temp\export.pst"
Const olFolderContacts = 10
On Error Resume Next
Dim olkApp 'As Outlook.Application
Dim objPST 'As Store
Dim fldRoot 'As Folder
Dim fldSrc 'As Folder
Dim fldDst 'As Folder
Dim conSrc 'As ContactItem
Dim conDst 'As ContactItem
'
Set olkApp = CreateObject("Outlook.Application")
With olkApp.Session
    Set fldSrc = .GetDefaultFolder(olFolderContacts)
    .AddStore PST_FILE
    For Each objPST In .Stores
        If objPST.FilePath = PST_FILE Then
            Exit For
        End If
    Next
    Set fldRoot = objPST.GetRootFolder()
    Set fldDst = fldRoot.Folders.Add("連絡先", olFolderContacts)
    If Err.Number <> 0 Then
        Set fldDst = fldRoot.Folders.Item("連絡先")
    End If
    For Each conSrc In fldSrc.Items
        Set conDst = conSrc.Copy()
        conDst.Move fldDst
    Next
    .RemoveStore fldRoot
End With

次に、下記のコードも同様に拡張子を .vbs として保存し、今度はインポートする PC で実行してください。
なお、PST ファイルはあらかじめ PC の "C:\temp\export.pst" としてコピーしておく必要があります。
ファイル名をネットワークパスにすることも可能ですが、ネットワークパスで PST を使う場合には破損の危険がありますので、PST ファイルはバックアップしておいてください。

' ここをトリプルクリックでマクロ全体を選択できます。
Const PST_FILE = "c:\temp\export.pst"
Const olFolderContacts = 10
On Error Resume Next
Dim olkApp 'As Outlook.Application
Dim objPST 'As Store
Dim fldRoot 'As Folder
Dim fldSrc 'As Folder
Dim fldDst 'As Folder
Dim conSrc 'As ContactItem
Dim conDst 'As ContactItem
'
Set olkApp = CreateObject("Outlook.Application")
With olkApp.Session
    Set fldDst = .GetDefaultFolder(olFolderContacts)
    .AddStore PST_FILE
    For Each objPST In .Stores
        If objPST.FilePath = PST_FILE Then
            Exit For
        End If
    Next
    Set fldRoot = objPST.GetRootFolder()
    Set fldSrc = fldRoot.Folders.Item("連絡先")
    For Each conSrc In fldSrc.Items
        Set conDst = conSrc.Copy()
        conDst.Move fldDst
    Next
    .RemoveStore fldRoot
End With

マクロの登録方法やメニューへの追加について

広告

連絡先をエクスポート・インポートするスクリプト」への14件のフィードバック

  1. VBSで正常にエクスポート・インポートが出来ました。(感謝!)。ところで、連絡先¥学年
    というフォルダを作って、学年以下のサブフォルダ以下を、エクスポート・インポートするように変更するにはどうしたらよいでしょうか?  インポートする前に、一度「学年」以下のフォルダを削除しないと、インポート後、重複してデータが表示されます。この点もどう対応したら良いかお教え願いますでしょうか?

  2. Set myOlApp = CreateObject(“Outlook.Application”)
    Set myNameSpace = myOlApp.GetNameSpace(“MAPI”)
    Set myFolder = myNamespace.GetDefaultFolder(10)
    Set myNewFolder = myFolder.Folders.Add(“1年A組”,10)

    上記のVBSで1年A組というフォルダは、「全てのフォルダ」の「連絡先」の下に、「1年A組」とフォルダは作成されますが、しかし、実際に「アドレス帳」を開いても、「Outlook」と、「連絡先」がプルダウンで表示されるだけで、「1年A組」というメニューは表示されません。どうしたらよいのでしょうか?教えていただけますでしょうか?

  3. 連絡先の「1年A組」を右クリックのプロパティで、「Outlookアドレス帳」の画面で
    「電子メールのアドレス帳にこのフォルダ-を表示する」にチェックを入れれば
    アドレス帳のプルダウンのメニューに表示されるようになりました。
    これをVBSを同時に設定することは可能なのでしょうか?

    • 以下のようにフォルダのプロパティの ShowAsOutlookAB を True とすればアドレス帳に表示されます。

      Set myNewFolder = myFolder.Folders.Add(“1年A組”,10)
      myNewFolder.ShowAsOutlookAB = True

      • さっそくのご回答ありがとうございました。大変たすかりました。試してみます。

  4. 下記のVBSで、連絡先のフォルダに 「連絡先」の下に「1年、2年、3年」のフォルダが作成されて、
    更にそれぞれの学年の下に「1年A組、1年B組」などのフォルダが階層で作成されますが、
    しかし、実際の「アドレス帳」を開いてみるとOutlookの下に、1年、と1年A組が同時に表示されてしまいます。「1年」の下に「1年A組」を表示させることはできないのでしょうか? 

    Set myFolder1 = myFolder.Folders.Add(“1年”,10)
    Set myFolder1a = myFolder1.Folders.Add(“1年A組”,10)
    Set myFolder1b = myFolder1.Folders.Add(“1年B組”,10)

    Set myFolder2 = myFolder.Folders.Add(“2年”,10)
    Set myFolder2a = myFolder2.Folders.Add(“2年A組”,10)
    Set myFolder2b = myFolder2.Folders.Add(“2年B組”,10)

    Set myFolder3 = myFolder.Folders.Add(“1年”,10)
    Set myFolder3a = myFolder3.Folders.Add(“3年A組”,10)
    Set myFolder3b = myFolder3.Folders.Add(“3年B組”,10)

    myFolder1.ShowAsOutlookAB = True
    myFolder1a.ShowAsOutlookAB = True
    myFolder1b.ShowAsOutlookAB = True

    myFolder2.ShowAsOutlookAB = True
    myFolder2a.ShowAsOutlookAB = True
    myFolder2b.ShowAsOutlookAB = True

    myFolder3.ShowAsOutlookAB = True
    myFolder3a.ShowAsOutlookAB = True
    myFolder3b.ShowAsOutlookAB = True

    • 下記の情報に、「アドレス帳のドロップダウンに連絡先が表示される場合、既定ではフォルダー名のみの昇順で表示されてしまう」という解説がありましたね・・・「既定では・・・」と書いてあることは、「特別な設定をすれば、」階層表示も可能だったりするのでしょうか?
      https://outlooklab.wordpress.com/2013/09/07/

      • 残念ながら階層表示にするような設定はありません。
        ただ、既定ではフォルダー名のみになってしまうアドレス帳の表示名を、パスを含むようなものに変更することで、疑似的に階層表示になるようにするというのが引用いただいたマクロの趣旨になります。

  5. すべてのフォルダの『連絡先」以下の1年、2年などを全て削除してから、PCを再起動しても、実際のアドレス帳を開くと、削除したはずのリストが表示され続けてしまうのはなぜでしょうか? 実際のアドレス帳の表示リストから削除するVBSはあるのでしょうか???

    • おそらくは、削除したフォルダーのサブフォルダーがアドレス帳から削除されていない状況と思われますが、VBA からはアドレス帳のリストに直接アクセスができません。
      リストに表示されているフォルダーのプロパティを変更することで、リストへの追加・削除が間接的に行えるというものになっています。
      そのため、予期せず残ってしまったサブフォルダーを削除するには、アカウント設定の [アドレス帳] の [Outlook アドレス帳] の設定で、不要な連絡先を削除する必要があります。

  6. アドレス帳に1個データを入力したものを エクスポートでc:\temp\55.csvに出力してからエクセルで開いて 新たに2人データを追加してから 再度outlookでインポートを実行した所、正常に 追加・登録ができました。

    c:\temp\55.csvを アドレス帳にインポートするVBSを どう作れば良いか教えていただけますでしょうか?

    • 先生PCのアドレス帳を40台の生徒PCのアドレス帳にコピーする方法は、C:\temp\export.pst を使う方法で運用する予定ですが、一番最初の先生PCのアドレス帳を作成するのは、どうしても、CSVからのインポートをVBSで行う必要がありますので、上記の方法を教えていただければ幸いです。よろしくお願いします。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中