Instale un soft DEMO que trae este modulo para desarrollo pero la verdad no puedo hacer nada todabia:
Public Function qrcode(ByVal strToEncode As String) As String
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("cruflBCS.QRCode.1")
cruflBCSObj.SetCRLF (1)
cruflBCSObj.ECLevel = 1
retval = cruflBCSObj.EncodeCR(strTemp, "0")
qrcode = retval
clearmem:
cruflBCSObj = Nothing
End Function
Public Function ascii2Char(strInput As String) As String
Dim i As Integer
Dim strTemp As String
Dim nPos As Integer
Dim nValue As Integer
i = 1
nPos = InStr(i, strInput, "&#", vbTextCompare)
While (nPos > 0)
ascii2Char = ascii2Char + Left(strInput, nPos - 1)
strInput = Right(strInput, Len(strInput) - nPos + 1)
i = 3
strTemp = ""
While (i <= Len(strInput) And IsNumeric(Mid(strInput, i, 1)) And Len(strTemp) < 3)
strTemp = strTemp + Mid(strInput, i, 1)
i = i + 1
Wend
nValue = 0
If (strTemp <> "") Then nValue = Val(strTemp)
If (nValue >= 0 And nValue < 128) Then
ascii2Char = ascii2Char + Chr(nValue)
ElseIf (nValue > 127 And nValue < 256) Then
ascii2Char = ascii2Char + ChrW(nValue)
Else
ascii2Char = ascii2Char + Left(strInput, i - 1)
End If
If (i <= Len(strInput) And Mid(strInput, i, 1) = ";") Then
i = i + 1
End If
strInput = Right(strInput, Len(strInput) - i + 1)
nPos = InStr(1, strInput, "&#", vbTextCompare)
Wend
If (Len(strInput) > 0) Then
ascii2Char = ascii2Char + strInput
End If
End Function
Pruebenlo y me dicen si sirva para algo
