Excel QR Generation Issues - & + - excel

So I have been using the following VBA Module code to generate QR codes in a desired cell. The code works as expected for all desired ASCII values expect '&' and '+'. If any of these characters is mid string example - Jack & Jill - only 'Jack' would be displayed, ie anything after, and including, the '&' would be cut off. Similar story with the '+'.
Thanks in advance
Function Insert_QR(codetext As String)
Dim URL As String, MyCell As Range​
​
Set MyCell = Application.Caller​
URL = "https://chart.googleapis.com/chart?chs=125x125&cht=qr&chl=" & codetext​
On Error Resume Next​
ActiveSheet.Pictures("My_QR_" & MyCell.Address(False, False)).Delete 'delete if there is prevoius one​
On Error GoTo 0​
ActiveSheet.Pictures.Insert(URL).Select​
With Selection.ShapeRange(1)​
.PictureFormat.CropLeft = 10​
.PictureFormat.CropRight = 10​
.PictureFormat.CropTop = 10​
.PictureFormat.CropBottom = 10​
.Name = "My_QR_" & MyCell.Address(False, False)​
.Left = MyCell.Left + 25​
.Top = MyCell.Top + 5​
End With​
Insert_QR = "" ' or some text to be displayed behind code​
End Function​

First thing first Google Image Charts is deprecated and can be shutdown anytime soon. There are alternatives like Image-Charts.
Regarding your issue codetext needs to be URLEncoded. If you are using Excel 2013+ you can use
URL = "https://image-charts.com/chart?chs=125x125&cht=qr&chl=" & WorksheetFunction.EncodeUrl(codetext)
Otherwise you can follow this answer that provide an URLEncode function that will also encode query params in order to generate the static QR code image.

The issue lay within the fact that the QR codes were being generated by URL. the above characters are what are known as URL restricted characters therefore cannot be repreneted in URL. therefore to represent '&' in URL == '%26'

Related

Application.Caption behaviour: returning Window caption as well

Application.Caption behaves differently according to whether you’re setting or returning the property.
For example, the following Sub:
Sub SetCap()
With Application
Debug.Print .Caption ' Returns the default: something like "Microsoft Excel - Book1"
.Caption = "MyCaption" ' Set the .Caption property to a custom string
.Windows(1).Caption = "MyWindow" ' Also customise the Window caption
Debug.Print .Caption ' This still returns "MyCaption - MyWindow"
End With
End Sub
I understand that the application caption and the window caption are two separate things, and by default they will appear in the title of the application together, separated by “ - ”.
You can assign any string you like to Application.Caption.
The curiosity, however, is that when returning the Application.Caption, instead of returning the string which you just set, the text will include the separator, and the Window caption as well.
Obviously you could split the string by “ - ” and return the first part:
Dim Arr As Variant
Arr = split(Application.Caption, “ - ”)
Debug.Print Arr(0)
...however this would fail if the actual Caption included such a string. For example if you did:
Application.Caption = “First Part – Second Part”
... then splitting as above would exclude the second part.
Does anyone know why this behaviour is present? And is there a way to only return the actual Application.Caption, without including the separator and Window caption?
You can workaround this with …
Debug.Print Right$(Application.Caption, Len(Application.Caption) - Len(ActiveWindow.Caption) - 3)
to get the caption you originally set before.
Why is it that it returns something else than was set before?
Because Microsoft made it that way.
Different versions seem to have a different order so
If Left$(Application.Caption, Len(ActiveWindow.Caption)) = ActiveWindow.Caption Then
Debug.Print Right$(Application.Caption, Len(Application.Caption) - Len(ActiveWindow.Caption) - 3)
Else
Debug.Print Left$(Application.Caption, Len(Application.Caption) - Len(ActiveWindow.Caption) - 3)
End If
might always return the correct result.

How can I pick specific string fragments out of an excel cell using a custom formula written in VBA

At work I am required to reformat incorrect Addresses on a weekly basis from records in our Salesforce instance. We gather the incorrectly formatted addresses using a Report and export them to an Excel file. My job is simply to manipulate the data in the file to format them properly then reinsert them into the database.
Typically the addresses are formatted as so:
5 Sesame Street, Anytown, Anyplace
Separating these can be done easily by hand, but I typically have to work with hundreds of addresses at a time, and using default excel formulas tends to require lots of wrangling multiple cells at once to break it up into fragments.
Thus I wrote a custom formula to run through the cell and return a specific fragment of the string based on the "Comma Number" given. So if I give a Comma Number of 1, I would get "5 Sesame Street", 2 would get me "Anytown", etc.
Here is my code so far:
Public Function fragmentAddress(address As String, numberofcommas As Integer) As String
seen = 1
lastComma = -1
Dim x As Long
Dim frag As Long
For x = 0 To Len(address)
If Mid(address, x, 1) = "," & numberofcommas = seen Then
Exit For
ElseIf Mid(address, x, 1) = "," & numberofcommas <> seen Then
seen = seen + 1
lastComma = x
End If
Next
frag = Mid(address, lastComma + 1, seen - lastComma)
fragmentAddress = frag
I have not implemented the ability to handle the final value yet, but it does not give me any outputs, only outputting a "#VALUE!" error when I attempt to give it the input
=fragmentAddress("3 Ashley Close, Charlton Kings",1)
I have some experience with programming, but this is my first time writing anything in VBA.
Any help would be appreciated, thank you.
Not exactly sure what your question is, but this is simpler:
Public Function GetAddressFragment(ByVal Address As String, ByVal Index As Integer) As String
Dim addr() As String
addr = Split(Address, ",")
On Error Resume Next
GetAddressFragment = Trim(addr(Index - 1))
End Function

Excel VB to shorten URLs with Bit.ly doesn't pass "%3d" in long URL

I'm building a VB macro that shortens URLs in bulk (we're talking thousands). My macro works just fine, until I encountered a long URL with "%3d", which translates into the equals symbol (=).
Here is and example of the long URL: http://domain.com/se/?st=YmUQaIg9PCoCs3vex5XHE1NnqfurVpWsXMXix0QkyO4%3d&p=A43S8C
My macro sends the entirety of the URL to Bit.ly, but Bit.ly's response text shows that it shortened this: http://domain.com/se/?st=YmUQaIg9PCoCs3vex5XHE1NnqfurVpWsXMXix0QkyO4=
And in fact, when I go to the shortened link, I'm not directed to the full URL.
This is the portion of my code that prompts Bit.ly and gets the response:
ApiRequest = "https://api-ssl.bitly.com/v3/shorten?access_token=" & Token & "&longUrl=" & LongURL
With HttpRequest
.Open "GET", ApiRequest, False
.Send
End With
Response = HttpRequest.ResponseText
HttpRequest.WaitForResponse
BeginCar = InStr(Response, "hash")
EndCar = BeginCar + 15
BitlyResult = Right(Mid(Response, BeginCar, (EndCar - BeginCar)), 7)
Range("J" & l).Value = "http://bit.ly/" & BitlyResult
How can I tell Bit.ly not to shorten a truncated URL and to keep the symbols such as "%3d"?
Thanks,
I'd think that you must escape the entire url when it is used as a parameter inside another url. The problem may not be %3d but the & that follows after it (it starts the next parameter in the bitly-url).
Try to escape this
http://domain.com/se/?st=YmUQaIg9PCoCs3vex5XHE1NnqfurVpWsXMXix0QkyO4%3d&p=A43S8C
entirely to
http%3A%2F%2Fdomain.com%2Fse%2F%3Fst%3DYmUQaIg9PCoCs3vex5XHE1NnqfurVpWsXMXix0QkyO4%253d%26p%3DA43S8C
Here are ways to do this in Excel.

How to handle Apostrophes ( ' ) using XPATH in QTP

chk this code snippet
Please refer the below code.
rv = “Are you 56' taller ?”
If I pass 20 fields ie, until [rv = “ Are you 56' taller ? "].
It’s not working because ‘ – apostrophe is used to comment in QTP
How to handle ' ( apostrophe ) in Xpath using QTP ?
Code Snippet:
rv = Replace (rv,"'", "\'")
rv = LEFT(rv,50)
If SVAL = "Yes" Then
Set oobj = Browser("xyz").Page("abc").WebElement("xpath:=//div[contains(text(),'"& rv &"')]/../..//label[starts-with(text(),'Yes')]")
oobj.Click
oobj.Click
i = i+1
End If
I really appreciate your reply.
Try with the character code chr(39) for apostrophe as shown below:
"Are you 56" & chr(39) & " taller ?"
As others mentioned this is not because ' is a comment in vbscript (not just QTP) but because you're ending the string too early.
You use single quotes for the string to compare to in the XPath and then the apostrophe closes the string too early. You should instead use regular quotes there too so that the apostrophe doesn't end the string too early.
In order to get a double quote in a string in VBScript write it twice "Like ""this"" for example".
So your XPath should look like this:
"//div[contains(text(),""Are you 56' taller ?"")]"
Rather than this:
"//div[contains(text(),'Are you 56' taller ?')]"
Or using your example:
Browser("xyz").Page("abc").WebElement("xpath:=//div[contains(text(),"""& rv &""")]/../..//label[starts-with(text(),'Yes')]")
(Note this has been tested and works)
Use &apos; rather than (') so that the string can be properly processed.
Supporting evidence -> click here.
This has nothing to do with the ' being the comment character. This is normal working code:
Msgbox "'I love deadlines. I like the whooshing sound they make as they fly by.' Douglas Adams"
Your code results into an error because some characters needs to be escaped like <, >, & and your infamous '. To enter the line above correctly into an XML tag you need to do this:
htmlEscaped = "&apos;I love deadlines. I like the whooshing sound they make as they fly by.&apos Douglas Adams"
Here you can find an overview to a set of the most common characters that needs escaping (while this is not totally true: if you are using Unicode/UTF-8 encoding, some characters will parse just fine).
Unfortunately VBScript does not have a native function that escapes HTML like the Escape function for urls. Only if you are on ASP Server, you can use Server.HtmlEncode but that is not the case with you
To generalize html escaping (treath everything as special except for the most commons) you can use a script like this:
Function HTMLEncode(ByVal sVal)
sReturn = ""
If ((TypeName(sVal)="String") And (Not IsNull(sVal)) And (sVal<>"")) Then
For i = 1 To Len(sVal)
ch = Mid(sVal, i, 1)
Set oRE = New RegExp : oRE.Pattern = "[ a-zA-Z0-9]"
If (Not oRE.Test(ch)) Then
ch = "&#" & Asc(ch) & ";"
End If
sReturn = sReturn & ch
Set oRE = Nothing
Next
End If
HTMLEncode = sReturn
End Function
It could be improved a bit (you'll notice passing objects into this function will result into an error) and made more specific: the regular expression could be matching more characters. I do also not know the performance of it, regular expressions can be slow if used incorrectly, but it proves as an example.

VBA PublishObjects. Add character formatting

I found the article about putting excel cells into an email using the RangetoHTML function in VBA. It works like a charm, but now I’m facing a Problem.
If there are Umlaut (e.g.: ü, ä, ö) in the cells the result in the email shows strange symbols (e.g.: ä, …).
I looked up the written temp.htm file. On the first view of this file, it seems the umlaute are correctly written, but after looking through the file with an hex editor i found that the written symbols are not correct.
The function which writes the file is: PublishObjects.Add
So I hope someone can help me with this.
Edit: Added a testfile. Word and Office is needed.
Select the table and run the procedure SendMail.
You will always have problems with vba and foreign chars and the web.
EDIT:
Because you can't separate the cell values from the html the function below will unfortunately not work in this situation. BUT:
if you Save a copy of the document with western European windows encoding it will work.
(See comments below).
To be able to do that you press "Save As" and there is a dropdown on the left side of the save button (Tools) which will give you a dialog where you can change the encoding.
The image has ben lifted from technet and always save web.. is not necessary.
EOF EDIT:
This is a function I have used, Unfortunately can't remember who I got it from, But its from the olden days of vba and classic asp
Put your email cell formula into this function and it should work because all the letters are html encoded. Its slow and makes a bad overhead. But it will work.
Function HtmlEncode(ByVal inText As String) As String
Dim i As Integer
Dim sEnc As Integer
Dim repl As String
HtmlEncode = inText
For i = Len(HtmlEncode) To 1 Step -1
sEnc = Asc(Mid$(HtmlEncode, i, 1))
Select Case sEnc
Case 32
repl = " "
Case 34
repl = """
Case 38
repl = "&"
Case 60
repl = "<"
Case 62
repl = ">"
Case 32 To 127
'Numbers
Case Else
repl = "&#" & CStr(sEnc) & ";" 'Encode it all
End Select
If Len(repl) Then
HtmlEncode = Left$(HtmlEncode, i - 1) & repl & Mid$(HtmlEncode, i + 1)
repl = ""
End If
Next
End Function

Resources