Saving as UTF-8 with VBA in Excel, and wrapping text with no orphans

So recently I’ve been working on a project that required a bit of research. It was NOT easy to find out this information, so I decided to post it here. The background for this story is that we’re working with Hungarian text, and only UTF-8 (not Unicode) saves it properly. Also, I needed the text to be wrapped at 69 characters, with no orphans (or single words on a line). First things first, here’s the code I used to save in UTF-8 (I didn’t come up with this, but I don’t know where I found it):

‘Function saves cText in file, and returns 1 if successful, 0 if not
Public Function writeOut(cText As String, file As String) As Integer
On Error GoTo errHandler
Dim fsT, tFilePath As String

tFilePath = file + “.txt”

‘Create Stream object
Set fsT = CreateObject(“ADODB.Stream”)

‘Specify stream type – we want To save text/string data.
fsT.Type = 2

‘Specify charset For the source text data.
fsT.CharSet = “utf-8”

‘Open the stream And write binary data To the object
fsT.Open
fsT.writetext cText

‘Save binary data To disk
fsT.SaveToFile tFilePath, 2

GoTo finish

errHandler:
MsgBox (Err.Description)
writeOut = 0
Exit Function

finish:
writeOut = 1
End Function

Not so difficult, right? If you have a better way to save as UTF-8, please let me know! Now for the difficult part: wrapping text. I have some redundancy, I know, but there are some irritating things about split that doesn’t make it easy to work with if there are double spaces, etc. Here’s my final code:

‘This function takes a string, and returns it with breaks every wrapLength characters
Private Function wrapText(text As String, Optional wrapLength As Integer) As String
Dim x As Integer, newString() As String, preSplit() As String, mySplit() As String, maxWords As Long, y As Integer, finalString As String, isEnd As Boolean
‘Default wraplength to 69
If wrapLength = 0 Then wrapLength = 69
x = 0
y = 0
z = 0
‘Check to see if ay wrapping should be done
If Len(text) > wrapLength Then
‘Resize the array to accomodate the number of wraps we’ll need
ReDim newString(Round((Len(text) / wrapLength), 0)) As String
‘Split the sentence on every space
preSplit = Split(text)
‘Count the number of non-empty elements in the split
For i = 0 To UBound(preSplit)
If Len(Trim(preSplit(i))) > 0 Then
z = z + 1
End If
Next
‘resize the word array, and put the non-empty elements in it
ReDim mySplit(z – 1) As String
z = 0
For i = 0 To UBound(preSplit)
If Len(Trim(preSplit(i))) > 0 Then
mySplit(z) = preSplit(i)
z = z + 1
End If
Next
newString(y) = mySplit(x)
x = x + 1
‘Get the number of words in the sentence
maxWords = UBound(mySplit)
While isEnd = False
‘If thereis text in this split
If Len(mySplit(x)) > 0 Then
‘and if the length of the current string plus the new split is less than or equal to our wraplength
If (Len(newString(y)) + Len(mySplit(x)) <= wrapLength) Then
‘add the new split to the string
newString(y) = newString(y) & ” ” & mySplit(x)
‘increment the split count
x = x + 1
Else
‘If we’re here then the next split will push us over our wrap length, so we’ll create a new wrap
y = y + 1
‘add the current split to this new wrap
newString(y) = mySplit(x)
‘increment the split count
x = x + 1
End If
Else
‘if we’re here then there was a double space
If (x = x + 1) <= maxWords Then x = x + 1 Else isEnd = True
End If
‘if we’re going to have an orphan, then quit
If maxWords – x = 1 Then isEnd = True
Wend
‘See if adding the next word will push us over our wrap length
If Len(newString(y)) + Len(mySplit(x)) + Len(mySplit(x + 1)) <= wrapLength Then
‘if not, add the word
newString(y) = newString(y) & ” ” & mySplit(x) & ” ” & mySplit(x + 1)
Else
‘otherwise, make a new line, and add both words there
y = y + 1
newString(y) = mySplit(x) & ” ” & mySplit(x + 1)
End If
‘Now, take the array, and make it into a regular string with returns after each array element
finalString = newString(0)
For x = 1 To UBound(newString)
If Len(newString(x)) > 0 Then finalString = finalString & Chr(10) & newString(x)
Next
Else
‘if we’re here then the text passed to us was not long enough to wrap
finalString = text
End If
wrapText = finalString
End Function

Again, if you know a better way, please let me know! Thanks!

2007

10/17

CATEGORY

VBA

TAGS

Excel
Unicode
UTF-8
VBA

Write comment