Using VCF to transfer contacts08 Nov 2008
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.
First of all I bluetoothed the entire phonebook to my laptop. This produced a single VCF file on my laptop.
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
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
Output) of VCF files in the same folder as the VCF
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 'Declarations 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 Initialise 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" Finalise Else 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 objFSO.CreateFolder(strOutputFolder) 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 Loop 'Write out the VCF record footer to the file and close it fOutput.WriteLine strLineOfText fOutput.Close '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" Else strLineOfText = fInput.ReadLine End If Loop fInput.Close Else MsgBox "Invalid parameter - the specified file is invalid: " & vbCrLf & strInputFile, vbOkOnly + vbExclamation, "VCF Splitter Error" Finalise End If End If Msgbox "Processing Complete", vbOkOnly + vbInformation, "VCF Splitter" Finalise Sub Initialise() Set objFSO = CreateObject("Scripting.FileSystemObject") intCounter = 0 End Sub Sub Finalise() Set objFSO = Nothing Set objFile = Nothing Wscript.Quit 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