Простой VBA скрипт для преобразования таблицы excel телефонной базы контактов в файл .vcf

Недавно я пытался перекинуть свои контакты из старого Блекберри в телефон с Андроидом и меня постигла неудача — оказалось не существует инструментов для корректного преобразования одного формата в другой.

Тогда я решил преобразовать мои контакты, полученные из старого телефона, в таблицу excel, и с помощью несложного скрипта в VBA преобразовать её файл вида .vcf, который можно скормить любому современному телефону.

Таблица у меня получилась такого вида:

Public Sub vcard()   Dim a(), i&, ii&, t  Dim b As String, OutDir As String  Dim fso As Object 'FileSystemObject  Dim txt As Object 'TextStream       a = [a1].CurrentRegion.Value     b = "" ' Переменная, в которую мы будем собирать информацию в формате .vcf              For i = 2 To UBound(a)              b = b & "BEGIN:VCARD" & vbNewLine & "VERSION:2.1" & vbNewLine         b = b & "FN:" & Cells(i, 1).Text & vbNewLine                  If Cells(i, 2).Text <> "" Then b = b & "EMAIL:" & Cells(i, 2).Text & vbNewLine         If Cells(i, 3).Text <> "" Then b = b & "ADR:" & Cells(i, 3).Text & ", " & Cells(i, 4).Text & vbNewLine         If Cells(i, 5).Text <> "" Then b = b & "TEL;HOME:" & Cells(i, 5).Text & vbNewLine         If Cells(i, 6).Text <> "" Then b = b & "TEL;CELL;PREF:" & Cells(i, 6).Text & vbNewLine         If Cells(i, 7).Text <> "" Then b = b & "TEL;WORK:" & Cells(i, 7).Text & vbNewLine         If Cells(i, 8).Text <> "" Then b = b & "ORG:" & Cells(i, 8).Text & vbNewLine         If Cells(i, 9).Text <> "" Then b = b & "TITLE:" & Cells(i, 9).Text & vbNewLine         If Cells(i, 10).Text <> "" Then b = b & "NOTE:" & Cells(i, 10).Text & vbNewLine          b = b & "END:VCARD" & vbNewLine              Next   OutDir = "C:\out\" 'Папка, в которую сохраним полученный файл      Set fso = CreateObject("Scripting.FileSystemObject")     Set txt = fso.CreateTextFile(OutDir & "out.vcf", 1, 1) 'Последний параметр - Unicode           txt.WriteLine b       txt.Close   End Sub 

Код перебирает строки и ячейки и если находит информацию в соответствующих ячейках создаёт соответствующую строчку в файле .vcf.

Вы можете сформировать другую табличку в excel и немого скорректировав скрипт сможете собрать свой файл .vcf.

Ничего сложного, но может кому-то понадобится.

P.S. для информации напоминаю структуру файла .vcf.

Начинаться контакт должен строками:
«BEGIN:VCARD»
«VERSION:2.1»

Далее идут ключи (они могут отсутствовать, тогда просто информации в соответствующих ячейках не будет)

«FN:» — название контакта
«EMAIL:» — электронная почта
«ADR:» — адресс
«TEL;HOME:» — домашний телефон
«TEL;CELL;PREF:» — сотовый телефон
«TEL;WORK:» — рабочий телефон
«ORG:» — название организации
«TITLE:» — должность
«NOTE:» — заметка

Контакт должен завершаться строчкой:
«END:VCARD»

В одном файле .vcf может быть сколь угодно много контактов, идущих друг за другом.