'**************************************
' Add Your Text That is to be inserted into the Dictionary
'**************************************
strText = objOriginalFile.ReadText
strText = strText & "Test1" & vbcrlf
strText = strText & "Test2" & vbcrlf
'**************************************
Currently, using this code, it will add the words, "Test1" and "Test2" to the custom dictionary. You can just update these lines to add your words or you could add some separate code that could read from a separate file and add the words from that file. If you wanted, you could also use the replace function to remove a word with some code like this:
strText = Replace(strText, "WordToReplace" & vbcrlf, "")
It is a lot of code for something that should be simple, but at this point it works and that is what is important to me. Enjoy the code.
' ExpertExchange
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'
' Add a value or values to Microsoft's Custom.Dic via script
' The file encoded in UCS-2 Little Endian (according to notepad++)
' Must open the file convert to UTF-8, add your words, and convert back
Option Explicit
' --------------------------------------------------------------------------------
' Set Up Variables, Define Constants and Instantiate objects
' --------------------------------------------------------------------------------
Dim objFSO, objOriginalFile, objTempFile, objNetwork, objNewFile, objShell
Dim strPath1, strPath2, strFile, strTempFile, strText
' Set Constants
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Const ForWriting = 2
Const TristateTrue = -1 'Opens Files as Unicode
Const DICTIONARYNAME = "CUSTOM.DIC"
' Instantiate Objects
Set objNetwork = CreateObject("WScript.Network")
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objShell = CreateObject("WScript.Shell")
Set objOriginalFile = CreateObject("ADODB.Stream")
Set objTempFile = CreateObject("ADODB.Stream")
Set objNewFile = CreateObject("ADODB.Stream")
' --------------------------------------------------------------------------------
' Set up the File Location (Microsoft Office moves this file around based on version)
' --------------------------------------------------------------------------------
' Set Values for possible file location based on MS Office Version
strPath1 = "C:\Users\" & objNetwork.UserName & "\AppData\Roaming\Microsoft\Spelling\en-US\"
strPath2 = "C:\Users\" & objNetwork.UserName & "\AppData\Roaming\Microsoft\UProof\"
' Find the location of the Dictionary file as it changes based on version
If objFSO.FileExists (strPath1 & DICTIONARYNAME) Then
strFile = strPath1 & DICTIONARYNAME
ElseIf objFSO.FileExists (strPath2 & DICTIONARYNAME) Then
strFile = strPath2 & DICTIONARYNAME
Else
Wscript.Echo DICTIONARYNAME & " was not found."
wcript.quit
End If
' Set Temp File
strTempFile = objShell.ExpandEnvironmentStrings("%TEMP%") & "\" & "TempDictionary.Dic"
' --------------------------------------------------------------------------------
' Open in ADO Stream to convert to UTF-8 and save in Temp File
' --------------------------------------------------------------------------------
' Open original File
objOriginalFile.Type = adTypeText
objOriginalFile.Charset = "unicode"
objOriginalFile.open
objOriginalFile.LoadFromFile strFile
'**************************************
'**************************************
' Add Your Text That is to be inserted into the Dictionary
'**************************************
strText = objOriginalFile.ReadText
strText = strText & "Test1" & vbcrlf
strText = strText & "Test2" & vbcrlf
'**************************************
'**************************************
' Save as UTF-8 File
objTempFile.Type = adTypeText
objTempFile.Charset = "utf-8"
objTempFile.Open
objTempFile.WriteText strText
objTempFile.SaveToFile strTempFile, adSaveCreateOverWrite
' Close the Files
objOriginalFile.Close
objTempFile.Close
' --------------------------------------------------------------------------------
' Now Open the UTF-8 file and use the File System Object to save it back as Unicode(UCS-2 Little Endian)
' --------------------------------------------------------------------------------
objNewFile.Type = adTypeText
objNewFile.Charset = "utf-8"
objNewFile.Open
objNewFile.LoadFromFile strTempFile
objFSO.OpenTextFile(strFile, ForWriting, True, TristateTrue).Write objNewFile.ReadText
objNewFile.Close
' --------------------------------------------------------------------------------
' Clean Up
' --------------------------------------------------------------------------------
Set objFSO = Nothing
Set objNetwork = Nothing
Set objNewFile = Nothing
Set objOriginalFile = Nothing
Set objTempFile = Nothing
Wscript.Echo strFile & " has been updated."
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)