Using VCF to transfer contacts

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

Buy me a coffee

Related posts that you may also like to read

• 

  VBScript: Flip Line Endings

  28 Jun 2015

  Recently I was working for a client who had particularly strict controls around access and tools that I could use. Whilst the bulk of the work I was carrying out on their Linux box could be managed using vi, I found it a little limiting when analysing some of the log files the work was producing. On the Windows machine I was using to access the files I only had Windows notepad and this really doesn’t handle Linux file endings well. As a result I put together a quick VBScript to help with this.

  Read More
• 

  Making HR Smarter

  29 Apr 2014

  “Change is the only constant.” - Heraclitus of Ephesus

  Change. It’s happening all the time, everywhere we look. In order to survive we need to adapt to the changes. In order to prosper we need to drive the changes. We need to constantly strive to improve and be smarter about what we do and how we do it.

  Read More
• 

  A Self Installing VBScript

  28 Feb 2014

  Over the years I’ve been doing technical support I’ve had quite a few useful VBS scripts that I’d copy over to a user’s machine. Then if it necessary, they could be run again at a later date (by remote control or referring the user to it’s location and get them to run it). However I quickly tired of manually doing this and dealing with the instances where I’d accidentally copied the script to the user’s desktop instead of the location I’d really wanted. As a result I created some extra lines to add into these scripts that would install the script to the desired location and then run it from there. This meant I could run it from a flash or network drive and it would automatically go to the right place - even updating older scripts.

  Read More
• 

  View Your Android Device on Your PC using Droid@Screen

  30 Jan 2014

  Android devices don’t have any native feature (currently) to mirror the display onto a PC. There are however a few alternative ways to accomplish this. In this post I’ll be giving a quick run down on how I got my Samsung Galaxy S2 to mirror it’s display onto my Windows laptop using Droid@Screen

  Read More