Excelマクロでスマホの連絡先作成

4719 ワード
VBA Excel マクロ エクセル Excel テキストリンク

初めに

自己責任でお願いいたします。
事前に連絡先のバックアップをお勧めします。
Androidでフリガナの指定が？でした。　色々とググりましたが…　結果マクロは未使用です。

Android ArrowsM03編

作成　↓　GoogleTel.csv

"Name","E-mail Address","Mobile Phone","Business Phone"
"沢村一樹","[email protected]","090xxxxyyy1","06yyyyzzz1"
"水野美紀","[email protected]","090xxxxyyy2","06yyyyzzz2"
"横山裕","[email protected]","090xxxxyyy3","06yyyyzzz3"
"本田翼","[email protected]","090xxxxyyy4","06yyyyzzz4"

インポート

ソース

Sub cre_CSV()
Dim strLine As String
Dim i As Long               '入力行
Dim j As Long               '入力列
Dim k As Long               '入力列数
Dim CSVFile As String
Dim strText As String
Dim adoSt As Object
k = 5
CSVFile = ActiveWorkbook.Path & "\GoogleTel.csv"
i = 1
Set adoSt = CreateObject("ADODB.Stream")
    adoSt.Charset = "UTF-8"
    adoSt.Open
    With Worksheets("TEL")
        Do Until .Cells(i, 2).Value = ""
            If .Cells(i, 1).Value = "〇" Then
                strText = ""
                For j = 2 To k - 1
                    strText = strText & """" & .Cells(i, j).Value & """" & ","
                Next j
                strText = strText & """" & .Cells(i, k).Value & """"
                adoSt.WriteText strText, 1
            End If
            '入力行
            i = i + 1
        Loop
    End With
    adoSt.SaveToFile CSVFile, 2
    adoSt.Close
Set adoSt = Nothing
MsgBox "完了", vbInformation, "( ..)φメモメモ"
End Sub

iOS iPhone11編

作成　↓　vCards.vcf

BEGIN:VCARD
VERSION:3.0
N:i沢村一樹
FN:i沢村一樹
X-PHONETIC-LAST-NAME:サワムライッキ
TEL;TYPE=CELL;TYPE=pref;TYPE=VOICE:090 1234 5678
END:VCARD
BEGIN:VCARD
VERSION:3.0
N:i水野美紀
FN:i水野美紀
X-PHONETIC-LAST-NAME:ミズノミキ
TEL;TYPE=CELL;TYPE=pref;TYPE=VOICE:070 1234 5678
END:VCARD
BEGIN:VCARD
VERSION:3.0
N:i横山裕
FN:i横山裕
X-PHONETIC-LAST-NAME:ヨコヤマユウ
TEL;TYPE=CELL;TYPE=pref;TYPE=VOICE:070 1111 2222
END:VCARD
BEGIN:VCARD
VERSION:3.0
N:i本田翼
FN:i本田翼
X-PHONETIC-LAST-NAME:ホンダツバサ
TEL;TYPE=CELL;TYPE=pref;TYPE=VOICE:070 2222 3333
END:VCARD

VCardを読み込む

ソース

Sub cre_vCards()
Dim strLine As String
Dim i As Long               '入力行
Dim vcfFile As String
Dim adoSt As Object
vcfFile = ActiveWorkbook.Path & "\vCards.vcf"
i = 2
Set adoSt = CreateObject("ADODB.Stream")
    adoSt.Charset = "UTF-8"
    adoSt.Open
    With Worksheets("TEL")
        Do Until .Cells(i, 2).Value = ""
            If .Cells(i, 1).Value = "〇" Then
                adoSt.WriteText "BEGIN:VCARD", 1
                adoSt.WriteText "VERSION:3.0", 1
                adoSt.WriteText "N:" & .Cells(1, 6).Value & .Cells(i, 2).Value, 1
                adoSt.WriteText "FN:" & .Cells(1, 6).Value & .Cells(i, 2).Value, 1
                adoSt.WriteText "X-PHONETIC-LAST-NAME:" & .Cells(i, 3).Value, 1
                adoSt.WriteText "TEL;TYPE=CELL;TYPE=pref;TYPE=VOICE:" & .Cells(i, 4).Value, 1
                adoSt.WriteText "END:VCARD", 1
            End If
            '入力行
            i = i + 1
        Loop
    End With
    adoSt.SaveToFile vcfFile, 2
    adoSt.Close
Set adoSt = Nothing
MsgBox "完了", vbInformation, "( ..)φメモメモ"
End Sub