Vcfカード形式で保存するマクロ

注意点

-　同名のファイルがある場合はそのまま書き換えてしまうので注意してください。
Vcfもいろいろな型があるので、携帯とOutlookで100%互換ではありません。
- ただテキスト形式で、メモ帳で開くことが可能なため、vcf形式において差はチェックしやすいです。
またOutlookファイルだと権限などでOutlookで送信しても開かない場合があります。
Vcf形式がその点テキストなので、送信できさえすれば、いざとなれば中身を開いてみることができます。
それでもダメな時は中身自体をメール本文でおくればよいわけです。

Explorer版

1.Outlookの画面でアドレス帳(People)のフォルダを開き(この画面がExplorerになります)、Vcard形式で保存したいContactItemを選択します。複数可能です
2.次のマクロを実行します。保存フォルダはCドライブのHogeです。
佐藤太郎.vcf のように姓名前で保存します。

SaveContactItemVcf

Sub SaveContactItemVcf()
Dim NS As NameSpace: Set NS = Application.Session
Dim olFol As Outlook.Folder: Set olFol = NS.GetDefaultFolder(olFolderContacts)
Dim AIN As Outlook.Inspector, AEX As Outlook.Explorer
Set AEX = ActiveExplorer
Dim Contact As ContactItem
Dim buf As String
Dim sPath As String: sPath = "C:\hoge" 'ここで保存するドライブ、フォルダを決めています。
For Each Contact In AEX.Selection
buf = Contact.FullName
Contact.SaveAs sPath & "\" & buf & ".vcf", olVCard
Next
End Sub

Inspector

こちらはinspector版です。今開いている住所(ContactItem)をvcf形式でc:hogeに保存します。

SaveInspectorContactItemVcf

Sub SaveInspectorContactItemVcf()
Dim NS As NameSpace: Set NS = Application.Session
Dim olFol As Outlook.Folder: Set olFol = NS.GetDefaultFolder(olFolderContacts)
Dim AIN As Outlook.Inspector, AEX As Outlook.Explorer
Set AIN = ActiveInspector
Dim Contact As ContactItem
Dim buf As String
Dim sPath As String: sPath = " C:\hoge" 'Decide Save folder
On Error Resume Next
Set Contact = AIN.CurrentItem
If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description: Err.Clear: Set NS = Nothing: Exit Sub
buf = Contact.FullName
Debug.Print buf
Contact.SaveAs sPath & "\" & buf & ".vcf", olVCard
On Error GoTo 0
Set NS = Nothing
End Sub

本来のVCard

How to use the vCard feature in Outlook OUTLOOKにおけるvCard機能について

CSVファイルと比較する

Csvの項目

CSVの項目名は言語で決まります。
しかし電子名刺（ビジネスカード）のデザインは出てきません。

肩書き TITLE;CHARSET=shift_jis:
名
ミドルネーム
姓
敬称
会社名
部署 ORG;CHARSET=shift_jis:会社名;○○部
役職
番地 (会社)
住所 2 (会社)
住所 3 (会社)
市町村 (会社)
都道府県 (会社)
郵便番号 (会社)
国 (会社)/地域
番地 (自宅)
住所 2 (自宅)
住所 3 (自宅)
市町村 (自宅)
都道府県 (自宅)
郵便番号 (自宅)
国 (自宅)/地域
番地 (その他)
住所 2 (その他)
住所 3 (その他)
市町村 (その他)
都道府県 (その他)
郵便番号 (その他)
国 (その他)/地域
秘書の電話
会社 FAX
会社電話
会社電話 2
コールバック
自動車電話
会社代表電話
自宅 FAX
自宅電話
自宅電話 2
ISDN
携帯電話
その他の FAX
その他の電話
ポケットベル
通常の電話
無線電話
TTY/TDD
テレックス
ID 番号
Web ページ
アカウント
イニシャル
インターネット空き時間情報
キーワード
その他住所私書箱
ディレクトリサーバー
プライベート
マネージャー
メモ
ユーザー1
ユーザー2
ユーザー3
ユーザー4
会社ID
会社住所私書箱
会社名フリガナ
記念日
経費情報
言語
参照事項
子供
支払い条件
事業所
自宅住所私書箱
趣味
場所
職業
姓フリガナ
性別
誕生日
電子メールアドレス
電子メールの種類
電子メール表示名
電子メール 2 アドレス
電子メール 2 の種類
電子メール 2 表示名
電子メール 3 アドレス
電子メール 3 の種類
電子メール 3 表示名
配偶者
秘書の氏名
秘密度
分類
名前フリガナ
優先度

Vcard(vdf)

すべてが出てきていません。該当がない項目は出力されないようです。
また電子名刺のデザインが出現します。

BEGIN:VCARD
VERSION:2.1
N;LANGUAGE=ja;CHARSET=shift_jis:姓;名
FN;CHARSET=shift_jis:姓 名
ORG;CHARSET=shift_jis:会社名;○○部
TITLE;CHARSET=shift_jis:社長
TEL;WORK;VOICE:000-000-1234
ADR;WORK;PREF;CHARSET=shift_jis:;;町１−１;市;県;000-0000;日本
LABEL;WORK;PREF;CHARSET=shift_jis;ENCODING=QUOTED-PRINTABLE:000-0000
X-MS-OL-DEFAULT-POSTAL-ADDRESS:2
EMAIL;PREF;INTERNET:mail@example.com
X-MS-CARDPICTURE;TYPE=JPEG;ENCODING=BASE64:
X-MS-OL-DESIGN;CHARSET=utf-8:<card xmlns="http://schemas.microsoft.com/office/outlook/12/electronicbusinesscards" ver="1.0" layout="left" bgcolor="ffffff"><img xmlns="" align="fit" area="16" use="cardpicture"/><fld xmlns="" prop="name" align="left" dir="ltr" style="b" color="000000" size="12"/><fld xmlns="" prop="org" align="left" dir="ltr" color="000000" size="10"/><fld xmlns="" prop="title" align="left" dir="ltr" color="000000" size="10"/><fld xmlns="" prop="dept" align="left" dir="ltr" color="000000" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="telwork" align="left" dir="ltr" color="d48d2a" size="10"><label align="left" color="626262"></label></fld><fld xmlns="" prop="email" align="left" dir="ltr" color="d48d2a" size="10"/><fld xmlns="" prop="addrwork" align="left" dir="ltr" color="000000" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/><fld xmlns="" prop="blank" size="10"/></card>
REV:20191001T052634Z
END:VCARD

https://social.technet.microsoft.com/Forums/en-US/1915b548-dbb0-4057-b6ac-db442fa7fa13/activesync-vcard-labels-mismatch-in-iphone-6-with-exchange-2010-profile-pic?forum=exchangesvrmobilitylegacy
ここの
Code that is appearing on the contact saved to server:
の項目の下にあるVCardはOutlookは読み込めるが、Printable以下は削除してある。

icloudはversion3.0

https://support.apple.com/ja-jp/guide/icloud/mmfba7399f/icloud
iCloud.comで連絡先情報を読み込む

それぞれの連絡先は、vCardと呼ばれる仮想的なカードとして表示されます。vCardsを読み込むことができます。

連絡先では、バージョン3.0以降のフォーマットのvCardを読み込むことができます。
1. iCloud.comの連絡先で、サイドバーの「操作」ポップアップメニューをクリックし、「vCardを読み込む」を選択します。
2. 読み込むvCardを選択します。
3. 読み込んだvCardの連絡先が、「すべての連絡先」グループに追加されます。連絡先を選択してグループにドラッグすることで、その連絡先をお好きなグループに追加することができます。

vCardに複数の人の連絡先情報が含まれている場合は、それぞれの連絡先が独立した項目になります。

vCardを読み込めない場合は、iCloud連絡先のサイズ制限を超過している可能性があります。Appleサポート記事「iCloudの連絡先、カレンダー、リマインダー、ブックマークの制限」を参照してください。
ガラケーからiPhoneへ、フリガナを含めて連絡先を移行する方法
上記2017年のSocial Technetでもiphoneは3.0だった。
つまり3.0といいながら2.1でも読めるらしい。

Vcard 3.0はRFC2426そのものらしい

（余談)メールの1行75文字という制限はVcardにもある

2.6 Line Delimiting and Folding

This profile supports the same line delimiting and folding methods
defined in [MIME-DIR]. Specifically, when parsing a content line,
folded lines must first be unfolded according to the unfolding
procedure described in [MIME-DIR]. After generating a content line,
lines longer than 75 characters SHOULD be folded according to the
folding procedure described in [MIME DIR].

Folding is done after any content encoding of a type value. Unfolding
is done before any decoding of a type value in a content line.

上記のリンク先でガラケーがSOUNDにフリガナを入れている

本来はSOUNDが入るので、使われていないところにフリガナを勝手にいれていたようだ。
ガラケーのvcfにはこのように独自仕様がある。

OUtlookのvcfが読み込めないという書き込みはマルチポスト

https://apple.stackovernet.com/ja/q/33577
https://askjapan.me/q/outlook-vcard-icloud-com-62606641677

Outlookとiphoneの住所録ではドイツ人は悩まない

Kontakt aus Outlook 2016 als VCard senden - seltsamer Code in Notizen
https://answers.microsoft.com/de-de/msoffice/forum/all/kontakt-aus-outlook-2016-als-vcard-senden/5b8da036-e515-4f94-a9e4-12632c730fba?auth=1
Q.うまくOutlookのvcfカードが読み込めないんだけど
A.Iphone に Outlook をインストールすることをお勧めします。互換性の問題はありません。

Outlookのvcfの`"http://schemas.microsoft.com/office/outlook/12/electronicbusinesscards"`

"http://schemas.microsoft.com/office/outlook/12/electronicbusinesscards"
上記の回答でも出てくるこれは現在MSの公式サイトの解説が見つかっていない。
しかしこれはschemaとなっていることから他のshemaの例から考えてみると、Outlook2007以降のOutlookが出力した電子ビジネスカードだよって書いてある。
Outlook2003までとvcfカードの出力方法が異なることがわかる。
またOutlook2019などしょせんOutlook2007なのである。
schemaについて説明はないが X-MS-OL-DESIGN;はいかに解説がある。
https://docs.microsoft.com/en-us/openspecs/exchange_server_protocols/ms-oxvcard/aa6d012e-64b9-4e15-99b8-d40a11b1ae2d
さらにこの項目はUSER-Definitionである。
さらにさらに
https://answers.microsoft.com/en-us/office/forum/office_2007-outlook/meaning-of-x-ms-ol-designcharsetutf-8/a251ee9d-8574-e011-8dfc-68b599b31bf5

No, it only applies to the custom X-MS-OL-DESIGN attribute of the vCard-file which stands for the layout of the (graphical) Business Card as shown in Outlook.

つまりX-MS-OLは不要

以上から、データのやり取りをするという趣旨ではこの項目も不要であるという結論になる。
電子名刺として連絡先を作成、共有する
ここでは名刺のテンプレートがあるとしているが
https://templates.office.com/#categories
にはOutlookはない。
つまり電子名刺はほとんど使われていないようである。ここからも削除してかまわないといえるようだ。

Encode-Printableを変換するユーザー定義関数

Function MailDecode(SourceData, CharSet, EncodeType)
'---------------------------------------------------
' MailDecode
' (
' SourceData: 変換元の文字列
' CharSet: 変換元の文字コード "shift-jis" "utf-8" "iso-2022-jp"など
' EncodeType: 変換元のエンコードタイプ "quoted-printable" "base64"など
' EncodeType: 変換元のエンコードタイプ "quoted-printable" "base64"など
' )
' Encodeされた文字列からもとの文字列を返すマクロ
' ADODB Stream CDO 参照設定
'---------------------------------------------------
' https://docs.microsoft.com/en-us/previous-versions/exchange-server/exchange-10/ms526277(v%3Dexchg.10)
' http://takryou79dev.blogspot.com/2013/06/vbscript-maildecode44k544oe44kk44or44ox.html
'Create CDO.Message object For the encoding.
Dim Message As New CDO.Message
'Set the encoding
' Message.BodyPart.ContentTransferEncoding = "quoted-printable"
' Message.BodyPart.ContentTransferEncoding = "base64"
Message.BodyPart.ContentTransferEncoding = EncodeType

'Get the data stream To write source string data
Dim Stream As New ADODB.Stream 'As ADODB.Stream
Set Stream = Message.BodyPart.GetEncodedContentStream
If VarType(SourceData) = vbString Then
'Set charset To base windows charset
Stream.CharSet = "windows-1250"
'Write the VBScript string To the stream.
Stream.WriteText SourceData
Else
'Set the type of the stream To adTypeBinary.
Stream.Type = 1

'Write the source binary data To the stream.
Stream.Write SourceData
End If

'Store the data To the message BodyPart
Stream.Flush

'Get an encoded stream
Set Stream = Message.BodyPart.GetDecodedContentStream

'Set the type of the stream To adTypeBinary.
Stream.CharSet = CharSet

'You can use Read method To get a binary data.
MailDecode = Stream.ReadText

End Function

OUTLOOK VBA アドレスをvcfで保存するマクロ