スマホの連絡先でエクスポートしたvcfファイルから、Excelのマクロを使って住所録シートを作成しました。vcfファイルの日本語部分のエンコード方法は、QUOTED-PRINTABLEでUTF-8でした。
スマホの連絡先からエクスポートしたファイルの拡張子はvcfだった
スマホが無いと、１日たりともまともな生活を送れないような今日この頃です。
もし、そのスマホを紛失したり、スマホが故障したりしたらどうしますか？
ぞっとしますよね？
中でも一番困ることは、スマホに登録していた連絡先を全て失うことではないでしょうか？
下手をすると、家族に緊急の連絡が取れなくなります。スマホにしか登録していなかった旧友とは、永久に連絡が取れなくなることになるかもしれません。
僕も、その場面を想像したらぞっとしたので、バックアップを取ることにしました。
僕は、Androidを使用しています。連絡先 → 連絡先の管理 → インポート/エクスポート という手順を辿ったら、問題なくバックアップを取ることができました。バックアップファイルにはvcfという拡張子が付いていました。
バックアップファイルは、スマホから他の媒体に移さないとバックアップになりません。そこで、vcfファイルをPCに移しました。
vcfファイルの中身はエンコードされていた
バックアップをとったからといって、安心はできません。バックアップから情報を取り出せる手段を準備しておく必要があります。
そこで、vcfファイルをテキストエディタで開いてみました。２人分のデータで、こんな感じに記録されていました。
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E6=A1=83;=E5=A4=AA=E9=83=8E;;;
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E6=A1=83=20=E5=A4=AA=E9=83=8E
X-PHONETIC-FIRST-NAME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E3=81=9F=E3=82=8D=E3=81=86
X-PHONETIC-LAST-NAME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E3=82=82=E3=82=82
TEL;CELL:090-876-54321
TEL;HOME:012-345-6789
EMAIL;HOME:taro@momo-sample.com
ADR;HOME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;=E9=AC=BC=E3=83=B6=E5=B3=B6=31=2D=31=2D=31;;;;
END:VCARD
BEGIN:VCARD
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E8=B5=AB=E5=A4=9C;=E5=A7=AB;;;
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E8=B5=AB=E5=A4=9C=20=E5=A7=AB
X-PHONETIC-FIRST-NAME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E3=81=B2=E3=82=81
X-PHONETIC-LAST-NAME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E3=81=8B=E3=81=90=E3=82=84
TEL;WORK:054-521-3380
EMAIL;HOME:hime@kaguya-sample.jp
ADR;HOME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;=E5=AF=8C=E5=A3=AB=E5=B8=82=E4=BC=9D=E6=B3=95=36=36=2D=32;;;;
END:VCARD
なんじゃこりゃ。
半角英数字で書かれた電話番号、E-mailアドレスは読めますが、日本語の部分は等号ばかりになってしまっていて読めません。
このバックアップを使う場合を想定してみました。スマホが使用不能になってしまい、切羽詰まった状態です。一刻も早く家族に連絡を取り、援助を要請したいことでしょう。
そんなときにPCが使えたとして、このvcfを開いてみると、何が書いてあるかわからない有様です。絶望的です。
vcfは、他の電子メールプログラムで読み取ることができるらしいです。試したことはありません。でも、その電子メールプログラムのアドレス帳上でいったん展開してしまうと、元に戻すときにかなりの手間がかかることが想像されますよね？甘受しますか？僕だったら嫌だなぁ。
UTF-8;ENCODING=QUOTED-PRINTABLEをデコードする
vcfファイルを改めて見直してみました。目に付くのは、「QUOTED-PRINTABLE」という文字です。これは、ASCIIコードしか扱えない電子メールシステム上で、ASCIIコード以外の文字を送るためのコーディング方法を意味するようです。その前の「UTF-8」というキーワードも重要そうです。
少し調べてみたところ、次のような手順を踏めばデコードできることが分かりました。
サンプルとして、４行目に出てくる「=E6=A1=83」をデコードしてみます。
先ず、等号を無視します。そして、0xE6、0xA1、0x83を3バイトのUTF-8のデータと見なします。２進法で示すと、1110 0110 1010 0001 1000 0011ですね。
始めに１が３つ並んでいるので、3バイトで1文字を示すことが分かります。
このとき、２バイト目、３バイト目の先頭の２ビットの10は読み飛ばす決まりです。
残ったビットだけを取り出して並べると、0110 1000 0100 0011となります。16進数に直せば、0x68、0x43となります。これをUnicodeデータとみなします。先頭にU+を付けるとU+6843となります。
ここまで来ると、WindowsのIMEパッドで文字を調べることができます。実際に調べてみると、「桃」であることが分かります。
手間はかかりますが、デコードはできます。
Excelのマクロでvcfから住所録を自動作成する
話が長くなりましたが、vcfから住所録を自動作成させるExcelのマクロを作りました。
先ず、標準モジュールを挿入し、以下のコードをに貼り付けて下さい。
Option Explicit
'-----------------------------------------------------------------------
' Summary: vcfファイルを読んで解析し、シートに表示する
'-----------------------------------------------------------------------
Public Sub ReadVcf()
' --- ファイルダイヤログを開いてvcfファイルのPathを取得する ---
Dim strFile As String ' ファイルのPath
' ファイルのPathを取得する
strFile = GetVcf
' ファイルのPathが取得できなければ何もしないで終了
If strFile = "" Then Exit Sub
' --- vcfファイルを開き、内容をstrOrgに読み込む ---
Dim intFile As Integer ' ファイル番号
' フリーのファイル番号を取得する
intFile = FreeFile
' 読み取り専用で開く
Open strFile For Input As #intFile
Dim strOrg As String ' 読み取ったvcfファイルの内容
' ファイルの最後まで繰り返し
Do Until EOF(intFile)
Dim strBuf As String ' 読み込み用のバッファ
' 一行読み込む
Line Input #intFile, strBuf
' 改行コードを付けて追記
strOrg = strOrg & strBuf & vbCrLf
Loop
' ファイルを閉じる
Close #intFile
' ファイルに内容が無ければ何もしないで終了
If strOrg = "" Then Exit Sub
' 最後にはvbCrLfの2バイトが余計に付いているので削除
strOrg = Left(strOrg, Len(strOrg) - 2)
' QUOTED-PRINTABLEは、等号後の改行は次行へ続くことを意味するので削除
strOrg = Replace(strOrg, "=" & vbCrLf, "")
' 本来はエンコード方法によって処理を変えるべきだが面倒なので削除
strOrg = Replace(strOrg, _
";CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE", "")
' --- UTF-8;ENCODING=QUOTED-PRINTABLEを一括デコードする ---
Dim j As Long ' 処理中の位置を示す変数
Dim k As Long ' QUOTED-PRINTABLEの終了位置を探すための変数
Dim lngLoc As Long ' 文字列を再構築するための位置を示す変数
Dim lngStart As Long ' QUOTED-PRINTABLEの開始位置
Dim lngStop As Long ' QUOTED-PRINTABLEの終了位置
Dim strContents As String ' デコード後の文字列
' 文字列を再構築するための位置をリセット
lngLoc = 1
' 一文字ずつ移動しながら調べる
For j = 1 To Len(strOrg) - 2
' QUOTED-PRINTABLEの開始位置と終了位置をリセット
lngStart = 0
lngStop = 0
' 等号の後に、16進数が２桁続いている場所を見つける
If Mid(strOrg, j, 3) Like "=[0-9A-F][0-9A-F]" Then
' 見つかった場合は、QUOTED-PRINTABLEの開始位置として保持
lngStart = j
' QUOTED-PRINTABLEの終了場所を三文字ずつ移動しながら調べる
For k = j + 3 To Len(strOrg) - 2 Step 3
If Mid(strOrg, k, 3) Like _
"=[0-9A-F][0-9A-F]" = False Then
' 終了位置を保持する
lngStop = k - 1
' For文を抜ける
Exit For
End If
Next k
' 開始位置が見つからない場合は、デコードを終える
If lngStart = 0 Then Exit For
' 終了位置が見つからない場合は文字列の最後を終了位置とする
If lngStop = 0 Then lngStop = Len(strOrg)
' "="を"%"に直して関数に投げるとデコードされる
' デコード前の文字列とデコード結果を合わせて追記
strContents = strContents & _
Mid(strOrg, lngLoc, lngStart - lngLoc) & _
PercentDecode(Replace( _
Mid(strOrg, lngStart, lngStop - lngStart + 1), _
"=", "%"))
' 文字列を再構築するための位置を修正
lngLoc = lngStop + 1
' 調査中の位置も修正
j = lngStop + 1
End If
Next j
' QUOTED-PRINTABLEされていない最後の部分を追記して再構築を完成
strContents = strContents & Mid(strOrg, lngLoc, Len(strOrg))
' --- 改行コードで区切って配列にする ---
Dim strLine() As String ' vcf1行が1要素の配列
' 配列を作成する
strLine = Split(Trim(strContents), vbCrLf)
' --- Excelシートに転記する ---
' シートをクリアする
Cells.Clear
Dim strRecord As String ' 個人情報を保持するレコード
Dim i As Integer ' Excelシートの行カウンタ
' Excelシートの行カウンタを初期化する
i = 0
' vcfの各行を調べる
For k = LBound(strLine) To UBound(strLine)
' 行の内容によって分岐処理
Select Case UCase(strLine(k))
' "BEGIN:VCARD"なら新しいレコードを始める
Case "BEGIN:VCARD"
' 行カウンタをインクリメント
i = i + 1
' 個人情報レコードをクリア
strRecord = ""
' "END:VCARD"なら情報をシートに転記する
Case "END:VCARD"
' レコードに情報があるときのみ処理を実行する
If strRecord <> "" Then
' 最後のTabを除去する
strRecord = Left(strRecord, Len(strRecord) - 1)
Dim strField() As String ' フィールド配列
' レコードをTabで区切ってフィールド配列を作成する
strField = Split(strRecord, vbTab)
' フィールの値をセルに順次書き込み
For j = LBound(strField) To UBound(strField)
Cells(i, j + 1) = "'" & strField(j)
Next j
End If
' レコードの開始や終了以外の場合の処理
Case Else
Dim strItem() As String ' コロンで区切って作成する配列
' vcfファイルの1行をコロンで区切って配列にする
strItem = Split(strLine(k), ":")
Dim strCond() As String ' タグの詳細条件を保持する配列
' タグをセミコロンで区切って得た詳細条件を配列に保持する
strCond = Split(strItem(0), ";")
' タグで分岐
Select Case UCase(strCond(0))
' バージョンと（フルネームでない）名前は無視する
Case "VERSION", "N"
' 表示しない
' ファーストネームの場合の処理
Case "X-PHONETIC-FIRST-NAME"
' タグを削除し、デリミタを付けない
strRecord = strRecord & Replace(strLine(k), strCond(0) & ":", "")
' ラストネームの場合の処理
Case "FN", "X-PHONETIC-LAST-NAME"
' タグを削除
strRecord = strRecord & Replace(strLine(k), strCond(0) & ":", "") & vbTab
' それ以外場合は、タブ区切りで追記
Case Else
strRecord = strRecord & strLine(k) & vbTab
End Select
End Select
Next k
' 列幅を整える
Cells.EntireColumn.AutoFit
End Sub
'-----------------------------------------------------------------------
' Summary: ファイルダイヤログを開いてvcfのPathを取得する
'-----------------------------------------------------------------------
Private Function GetVcf() As String
' FileDialogオブジェクトを宣言する
Dim fd As FileDialog
' FileDialogオブジェクトをファイルピッカーダイアログとする
Set fd = Application.FileDialog(msoFileDialogFilePicker)
' 選択されたファイルへのPathを保持する変数の宣言
Dim strFile As String
With fd
' Excelファイル選択用のフィルタをセット
.Filters.Add "vCard", "*.vcf*"
' 単一ファイル選択
.AllowMultiSelect = False
' ボタンが押された場合の処理
If .Show = True Then
' ファイルのPathを変数にセットする
strFile = .SelectedItems(1)
End If
End With
' FileDialogオブジェクトの解放
Set fd = Nothing
' 戻り値のセット
GetVcf = strFile
End Function
' https://fumokmm.github.io/it/vba/url_decode#decoding-utf-8-percent-encoded-strings
' より引用
' UTF-8でパーセントエンコードされた文字列をデコードします
'
' @param percentEncodedStr UTF-8でパーセントエンコードされた文字列
' @return デコードした文字列
'
' ※ADODB.Streamを利用するため、ツール > 参照設定で
' 「Microsoft ActiveX Data Objects 6.1 Library」を追加してください。
'
Public Function PercentDecode(percentEncodedStr As String) As String
' 空文字なら空文字を返却
If IsEmpty(percentEncodedStr) Then
PercentDecode = ""
Exit Function
End If
' ストリームをオープン
Dim objStm As ADODB.Stream
Set objStm = New ADODB.Stream
objStm.Open
' ストリームをリセット
objStm.Position = 0
objStm.SetEOS
' バイナリを書き込み
objStm.Type = ADODB.adTypeBinary
objStm.Write ToHexBytes(percentEncodedStr)
' UTF-8でテキスト読み込み
objStm.Position = 0
objStm.Type = ADODB.adTypeText
objStm.Charset = "UTF-8"
PercentDecode = objStm.ReadText() ' 結果返却
' ストリームをクローズ
objStm.Close
Set objStm = Nothing
End Function
' https://fumokmm.github.io/it/vba/url_decode#decoding-utf-8-percent-encoded-strings
' より引用
'''
' UTF-8でパーセントエンコードされた文字列をバイト配列に変換します
'
' @param percentEncodedStr UTF-8でパーセントエンコードされた文字列
' @return バイト配列
'
Private Function ToHexBytes(percentEncodedStr As String) As Byte()
Dim size As Long
size = Len(percentEncodedStr) / 3
Dim bytes() As Byte
ReDim bytes(0 To size - 1)
Dim i As Long
For i = 0 To size - 1
bytes(i) = Val("&H" & Mid(percentEncodedStr, (i * 3) + 2, 2))
Next i
ToHexBytes = bytes
End Function
続いて、ツール → 参照設定を選択し、「Microsoft ActiveX Data Objects x.x Library」をチェック → OK します。このとき、項目を選択してもチェックが入らない場合があります。確実にチェックしないと「ユーザー定義型は定義されていません」というコンパイルエラーが出ますので、ご注意下さい。x.xはバージョン番号であり、一番大きい数値をお選びください。僕の場合は、6.1でした。
その後、ReadVcfというマクロを実行してください。
マクロを使ったことがないという方は、こちらの記事をご覧ください。
ReadVcfを実行すると、vcfファイルの場所を訪ねてくるので、選択して選んでください。
vcfファイルが選択されると、一旦、全てを読み込み、まとめてUTF-8;ENCODING=QUOTED-PRINTABLEの部分をエンコードします。
UTF-8をデコードする部分は、ふもさんが開発された関数を引用させていただきました
その後、BEGIN:VCARDからEND:VCARDまでを一人分のデータとして、列方向に追記していきます。
住所録シート
名前とフリガナはタグを取り除きましたが、その他は情報が削られないようにタグを残しました。人によって記録してある項目が異なるので、カラムをタグ固定にするのは止めました。
まとめ
スマホのバックアップファイルの内容を確認するExcelマクロを作成し、内容の確認ができました。
万一、スマホが使えない状況になっても、PCが使えれば、連絡先を確認できるようになったので、一安心です。
ただし、コーディング条件は、UTF-8;ENCODING=QUOTED-PRINTABLEです。機種によって異なる場合がありますので、ご注意ください。
コメント