How To Automatically Create Vcard QR Codes Using Excel Macros?

Sub generateQRCode()

strURL = "https://chart.googleapis.com/chart?cht=qr" For intRow = 2 To 5 strFname = Trim(ThisWorkbook.Sheets("Contact_Info").Range("A" & intRow).Text) strLname = Trim(ThisWorkbook.Sheets("Contact_Info").Range("B" & intRow).Text) strCellPhone = Trim(ThisWorkbook.Sheets("Contact_Info").Range("C" & intRow).Text) strBusPhone = Trim(ThisWorkbook.Sheets("Contact_Info").Range("D" & intRow).Text) strEmail = Trim(ThisWorkbook.Sheets("Contact_Info").Range("E" & intRow).Text) strCompn = Trim(ThisWorkbook.Sheets("Contact_Info").Range("F" & intRow).Text) strJobTitle = Trim(ThisWorkbook.Sheets("Contact_Info").Range("G" & intRow).Text) strDept = Trim(ThisWorkbook.Sheets("Contact_Info").Range("H" & intRow).Text) strVCF = "" strVCF = strVCF & "BEGIN:VCARD" & Chr(10) strVCF = strVCF & "VERSION:3.0" & Chr(10) strVCF = strVCF & "N:" & strLname & ";" & strFname & Chr(10) strVCF = strVCF & "ORG:" & strCompn & Chr(10) strVCF = strVCF & "TITLE:" & strJobTitle & " \| " & strDept & Chr(10) strVCF = strVCF & "FN:" & strFname & Chr(10) strVCF = strVCF & "TEL;TYPE=CELL:" & strCellPhone & Chr(10) strVCF = strVCF & "TEL;TYPE=WORK;TYPE=PREF:" & strBusPhone & Chr(10) strVCF = strVCF & "EMAIL:" & strEmail & Chr(10) strVCF = strVCF & "END:VCARD" ThisWorkbook.Sheets("Contact_Info").Range("I" & intRow) = strVCF strChs = "&chs=174" & "x" & "174" strChl = "&chl=" strFinalURL = strURL & strChs & strChl & strVCF Dim pic As Object, sh As Shape ActiveSheet.Range("J" & intRow).Select Set pic = ActiveSheet.Pictures.Insert(strFinalURL) pic.Top = ActiveSheet.Range("J" & intRow).Top pic.Left = ActiveSheet.Range("J" & intRow).Left Next End Sub