'MacroName:Unicode2ALA 'MacroDescription:Convert punctuation and precomposed Unicode characters to valid ALA/ANSEL characters 'Macro written by: Joel Hahn, Niles Public Library District 'Last modified: 6 Nov 2012 Option Explicit Declare Function ConvertUnicodeEntity(sCode As String) As String Sub Main Dim bool, i As Integer Dim sField, sDecomposedChars, sNewField As String Dim CS As Object On Error Resume Next Set CS = GetObject(,"Connex.Client") On Error GoTo 0 If CS Is Nothing Then Set CS = CreateObject("Connex.Client") End If 'retval = CS.Validate(sErrorList) 'Only lists the first such error in each field, but could be useful for identifying which fields need this processing 'MsgBox sErrorList CS.CursorColumn = 9999 bool = CS.InsertText("А") bool = CS.GetFieldLineUnicode(CS.CursorRow, sField) CS.CursorColumn = CS.CursorColumn - 1 bool = CS.DeleteToEndOfCell sField = Left(sField, Len(sField) - 8) i = 1 Do While i <= Len(sField) If Asc(Mid(sField, i, 1)) > 127 Then 'Convert high-ASCII character Select Case Asc(Mid(sField, i, 1)) Case 161 'inverted exclamation point sDecomposedChars = Chr(201) Case 162 'cent sign sDecomposedChars = "c" & Chr(245) Case 163 'British pound sDecomposedChars = Chr(185) Case 165 'Yen sign sDecomposedChars = "[yen]" Case 167 'section sign sDecomposedChars = "[section]" Case 168 'spacing umlaut sDecomposedChars = Chr(232) Case 169 'copyright sign sDecomposedChars = Chr(202) Case 170 'ordinal "a" sDecomposedChars = "a." Case 171 'angled left quotation sDecomposedChars = Chr(34) Case 172 'negation symbol sDecomposedChars = "[not]" Case 174 'registered trademark sDecomposedChars = Chr(170) Case 175 'spacing macron sDecomposedChars = Chr(229) Case 176 'degree sign sDecomposedChars = Chr(158) Case 177 'registered trademark sDecomposedChars = Chr(171) Case 178 'superscript 2 sDecomposedChars = Chr(130) Case 179 'superscript 3 sDecomposedChars = Chr(131) Case 180 'spacing acute sDecomposedChars = Chr(39) 'Chr(226) Case 181 '"micro-" symbol sDecomposedChars = "[micro]" Case 182 'paragraph symbol sDecomposedChars = "[paragraph]" Case 183 'middle dot sDecomposedChars = Chr(168) Case 184 'spacing cedilla sDecomposedChars = Chr(240) Case 185 'superscript 1 sDecomposedChars = Chr(129) Case 186 'ordinal "o" sDecomposedChars = "o." Case 187 'angled right quotation sDecomposedChars = Chr(34) Case 188 '1/4 fraction sDecomposedChars = "1/4" Case 189 '1/2 fraction sDecomposedChars = "1/2" Case 190 '3/4 fraction sDecomposedChars = "3/4" Case 191 'inverted question mark sDecomposedChars = Chr(200) Case 192 'A-grave sDecomposedChars = "A" & Chr(225) Case 193 'A-acute sDecomposedChars = "A" & Chr(226) Case 194 'A-circumflex sDecomposedChars = "A" & Chr(227) Case 195 'A-tilde sDecomposedChars = "A" & Chr(228) Case 196 'A-umlaut sDecomposedChars = "A" & Chr(232) Case 197 'A-angstrom sDecomposedChars = "A" & Chr(234) Case 198 'AE-ligature sDecomposedChars = Chr(165) Case 199 'C-cedilla sDecomposedChars = "C" & Chr(240) Case 200 'E-grave sDecomposedChars = "E" & Chr(225) Case 201 'E-acute sDecomposedChars = "E" & Chr(226) Case 202 'E-circumflex sDecomposedChars = "E" & Chr(227) Case 203 'E-umlaut sDecomposedChars = "E" & Chr(232) Case 204 'I-grave sDecomposedChars = "I" & Chr(225) Case 205 'I-acute sDecomposedChars = "I" & Chr(226) Case 206 'I-circumflex sDecomposedChars = "I" & Chr(227) Case 207 'I-umlaut sDecomposedChars = "I" & Chr(232) Case 208 'Eth, uppercase sDecomposedChars = Chr(163) Case 209 'N-tilde sDecomposedChars = "N" & Chr(228) Case 210 'O-grave sDecomposedChars = "O" & Chr(225) Case 211 'O-acute sDecomposedChars = "O" & Chr(226) Case 212 'O-circumflex sDecomposedChars = "O" & Chr(227) Case 213 'O-tilde sDecomposedChars = "O" & Chr(228) Case 214 'O-umlaut sDecomposedChars = "O" & Chr(232) Case 215 'multiplication sign sDecomposedChars = "x" Case 216 'O-slash sDecomposedChars = Chr(162) Case 217 'U-grave sDecomposedChars = "U" & Chr(225) Case 218 'U-acute sDecomposedChars = "U" & Chr(226) Case 219 'U-circumflex sDecomposedChars = "U" & Chr(227) Case 220 'U-tilde sDecomposedChars = "U" & Chr(228) Case 221 'Y-acute sDecomposedChars = "Y" & Chr(226) Case 222 'Thorn, uppercase sDecomposedChars = Chr(164) Case 223 'Esstzet sDecomposedChars = Chr(159) Case 224 'a-grave sDecomposedChars = "a" & Chr(225) Case 225 'a-acute sDecomposedChars = "a" & Chr(226) Case 226 'a-circumflex sDecomposedChars = "a" & Chr(227) Case 227 'a-tilde sDecomposedChars = "a" & Chr(228) Case 228 'a-umlaut sDecomposedChars = "a" & Chr(232) Case 229 'a-angstrom sDecomposedChars = "a" & Chr(234) Case 230 'ae-ligature sDecomposedChars = Chr(181) Case 231 'c-cedilla sDecomposedChars = "c" & Chr(240) Case 232 'e-grave sDecomposedChars = "e" & Chr(225) Case 233 'e-acute sDecomposedChars = "e" & Chr(226) Case 234 'e-circumflex sDecomposedChars = "e" & Chr(227) Case 235 'e-umlaut sDecomposedChars = "e" & Chr(232) Case 236 'i-grave sDecomposedChars = "i" & Chr(225) Case 237 'i-acute sDecomposedChars = "i" & Chr(226) Case 238 'i-circumflex sDecomposedChars = "i" & Chr(227) Case 239 'i-umlaut sDecomposedChars = "i" & Chr(232) Case 240 'eth, lowercase sDecomposedChars = Chr(186) Case 241 'n-tilde sDecomposedChars = "n" & Chr(228) Case 242 'o-grave sDecomposedChars = "o" & Chr(225) Case 243 'o-acute sDecomposedChars = "o" & Chr(226) Case 244 'o-circumflex sDecomposedChars = "o" & Chr(227) Case 245 'o-tilde sDecomposedChars = "o" & Chr(228) Case 246 'o-umlaut sDecomposedChars = "o" & Chr(232) Case 247 'division sign sDecomposedChars = "[divided by]" Case 248 'o-slash sDecomposedChars = Chr(178) Case 249 'u-grave sDecomposedChars = "u" & Chr(225) Case 250 'u-acute sDecomposedChars = "u" & Chr(226) Case 251 'u-circumflex sDecomposedChars = "u" & Chr(227) Case 252 'u-umlaut sDecomposedChars = "u" & Chr(232) Case 253 'y-acute sDecomposedChars = "y" & Chr(226) Case 254 'thorn, lowercase sDecomposedChars = Chr(180) Case 255 'y-umlaut sDecomposedChars = "y" & Chr(232) Case Else 'Unconvertable character sDecomposedChars = "" End Select sNewField = sNewField + sDecomposedChars Else Select Case Asc(Mid(sField, i, 1)) Case 38 'ampersand sDecomposedChars = "&" If Len(sField) > i and Mid(sField, i+1, 2) = "#x" Then 'Unicode entity; most can be left as is, but a few are candidates for decomposing or converting sDecomposedChars = ConvertUnicodeEntity(Mid(sField, i, 8)) i = i + 7 End If Case 96 'spacing grave sDecomposedChars = Chr(39) 'Chr(225) Case 124 'vertical bar/pipe sDecomposedChars = Chr(223) Case Else sDecomposedChars = Mid(sField, i, 1) End Select sNewField = sNewField + sDecomposedChars End If i = i + 1 Loop 'MsgBox sNewField bool = CS.SetFieldLine(CS.CursorRow, sNewField) End Sub Function ConvertUnicodeEntity(sCode As String) As String If sCode = "…" Then sCode = "..." ElseIf sCode = "‘" Then sCode = Chr(39) ElseIf sCode = "’" Then sCode = Chr(39) ElseIf sCode = "“" Then sCode = Chr(34) ElseIf sCode = "”" Then sCode = Chr(34) ElseIf sCode = "–" Then sCode = "-" ElseIf sCode = "—" Then sCode = "--" ElseIf sCode = "€" Then sCode = Chr(160) 'Ā through ž = various letter+diacritic combinations 'Ơ through ơ = O/o with horn 'Ư through ư = U/u with horn 'Ǎ through ǰ = various letter+diacritic combinations 'Ǵ through ȗ = various letter+diacritic combinations 'Ḁ through ẚ = various letter+diacritic combinations 'Ạ through ỹ = various letter+diacritic combinations End If ConvertUnicodeEntity = sCode End Function