Using VCF to transfer contacts

I recently changed my mobile phone to a Samsung Omnia i900.  Whilst there are several issues with it at the moment - mainly due to Vodafone being way behind on tweaking any of the Samsung firmware releases, I’ve found it to be a good phone, but it hasn’t been great at getting the contact data off of my previous phone; a Sony Ericsson K800i.

After trying a few options I managed to get a neat transfer of data that worked well.

Step 1

First of all I bluetoothed the entire phonebook to my laptop.  This produced a single VCF file on my laptop.

Step 2

I wrote a VBScript that splits a combined VCF file into individual VCF files and I’ve made it available at the end of this post - just copy and paste it into a ‘text’ file called something like VCF Splitter.vbs.  The next step was simply to run this script against the file by just dragging and dropping the VCF file onto the script.  This creates a folder (called Output) of VCF files in the same folder as the VCF file.

Step 3

I then bluetoothed the VCF files I wanted from the Output folder to the new phone.

Not as easy as I’d first envisaged the transfer to be but hopefully you will now find it relatively painless.

VCF Splitter.vbs Source Code

Option Explicit

Dim objFSO, objFile
Dim fInput, fOutput
Dim strInputFile, strOutputFolder, strLineOfText
Dim strOrg, strName
Dim intCounter

'The folder that holds the VCF phonebook file will also contain the output folder.
'This constant should be prefixed with a slash followed by the name of the desired
'output folder.
Const OUTPUT_FOLDER = "\Output"

'Main Routine
If Wscript.Arguments.Count = 0 Then
'No file passed in so give the user some help
MsgBox "This script takes the input file as a parameter." & vbCrLf & "Just drag and drop the file onto the script file to split it" & vbCrLf & "or run the script with the file as a command line parameter.", vbOkOnly + vbInformation, "VCF Splitter Instructions"
strInputFile = Wscript.Arguments(0)
'We've got a file path, but it could have been passed as a command line parameter and be incorrect
'so first check if it really exists
If objFSO.FileExists(strInputFile) Then
Set objFile = objFSO.GetFile(strInputFile)
strOutputFolder = objFile.ParentFolder & OUTPUT_FOLDER

'If the output folder doesn't exist, create it
If Not objFSO.FolderExists(strOutputFolder) Then
End If

Set fInput = objFSO.OpenTextFile(strInputFile ,1,0)
strLineOfText = fInput.ReadLine

'Split the phonebook into separate VCF files in the output folder
Do Until fInput.AtEndOfStream
If Left(strLineOfText,11) = "BEGIN:VCARD" then
'Use a counter to give us a unique name for the VCF file
intCounter = intCounter +1
Set objFile = CreateObject("Scripting.FileSystemObject")
Set fOutput = objFile.CreateTextFile(strOutputFolder & "\" & CStr(intCounter) & ".vcf",True)

fOutput.WriteLine strLineOfText
strLineOfText = fInput.ReadLine
strOrg = ""
strName = ""
Do Until left(strLineOfText,9) = "END:VCARD"
'Store the organisation and name if they exist
If Left(strLineOfText,4) = "ORG:" then
strOrg = Right(strLineOfText,len(strLineOfText)-4)
End If
If Left(strLineOfText,2) = "N:" then
strName = Right(strLineOfText,len(strLineOfText)-2)
End If

'Output the separate VCF file for the contact
fOutput.WriteLine strLineOfText
strLineOfText = fInput.ReadLine

'Write out the VCF record footer to the file and close it
fOutput.WriteLine strLineOfText

'Rename the files to include the relevant organisation and name
objFSO.MoveFile strOutputFolder & "\" & CStr(intCounter) & ".vcf", strOutputFolder & "\Contact -" & StripBadCharacters(strOrg) & "-" & StripBadCharacters(strName) & " " & CStr(intCounter) & ".vcf"
strLineOfText = fInput.ReadLine
End If
MsgBox "Invalid parameter - the specified file is invalid: " & vbCrLf & strInputFile, vbOkOnly + vbExclamation, "VCF Splitter Error"
End If
End If
Msgbox "Processing Complete", vbOkOnly + vbInformation, "VCF Splitter"

Sub Initialise()
Set objFSO = CreateObject("Scripting.FileSystemObject")
intCounter = 0
End Sub

Sub Finalise()
Set objFSO = Nothing
Set objFile = Nothing

End Sub

Function StripBadCharacters(strInput)
'Remove characters that might would be invalid in a filename
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "[^A-Z^a-z^0-9\s]"
StripBadCharacters = objRegExp.Replace(strInput, "")
End Function
Author: Stephen Millard
Tags: | mobile | vbs |

Buy me a coffeeBuy me a coffee

Related posts that you may also like to read