VBA to add word list to Custom Dictionary
Page 1 of 2 12 LastLast
Results 1 to 10 of 12

Thread: VBA to add word list to Custom Dictionary
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to add word list to Custom Dictionary

    In Excel VBA this checks the Custom Dictionary for a word:

    Sub myDicList()
    Dim myWord$, myDic$

    myDic = Application.SpellingOptions.UserDict

    myWord = InputBox("Check the Dictionaries for the Word you enter below." & _
    vbLf & vbLf & "Note: Your custom dictionary is currently set to:" & vbLf & _
    " " & myDic, "Lookup Your Word!")

    If myWord = "" Then GoTo myEnd

    If Not Application.CheckSpelling(myWord, CustomDictionary:=myDic, IgnoreUppercase:=False) Then
    MsgBox "Not in dictionary!"

    Else
    MsgBox "Is in dictionary!"

    End If

    myEnd:
    End Sub


    But, this next code only creates a dummy custom.dic and does not update the real user custom dictionary?

    Sub add_Dic()
    Dim myWord$

    Close #1
    Open Application.SpellingOptions.UserDict For Output As #1

    myWord = Selection.Value

    If Not IsEmpty(myWord) Then
    Write #1, myWord

    MsgBox myWord & ", was Added to the current custom dictionary: " _
    & Application.SpellingOptions.UserDict
    End If

    Close #1

    End Sub

    Does anyone know if you can add words by code?

    From help it points to WORD as a way, but could not get it there as well?

    In WORD VBA this lists the Custom Dictionaries, but can't seem to add any words to it by code?

    Sub myDicts()

    For Each d In CustomDictionaries

    If d.Name = Application.CustomDictionaries.ActiveCustomDictionary.Name Then
    MsgBox "Active Dictionary: " & d.Path & Application.PathSeparator & d.Name
    Else
    MsgBox "InActive Dictionary: " & d.Path & Application.PathSeparator & d.Name
    End If

    d.Write "Relo"
    Next d

    End Sub


    Any ideas on adding a list of words to an Office User Defined Custom Dictionary used by Spell-Check?

    The key-word Scripting Dictionary is not checked by SpellCheck even though you can add to it by code?
    JSW: Try and try again: "The way of the Coder!"

  2. #2
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    75,112
    Post Thanks / Like
    Mentioned
    60 Post(s)
    Tagged
    6 Thread(s)

    Default

    Joe

    Shouldn't you be using Append instead of Output here?
    Code:
    Open Application.SpellingOptions.UserDict For Output As #1
    This worked for me.
    Code:
    Sub add_Dic()
    Dim myWord$
    
        Set myCust = Application.CustomDictionaries.ActiveCustomDictionary
        
        Open myCust.Path & "\" & myCust.Name For Append As #1
        
            myWord = "Another New Word"
            
            If Not IsEmpty(myWord) Then
                Print #1, myWord
            End If
        
        Close #1
    
    End Sub
    If posting code please use code tags.

  3. #3
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Norie,

    Was running around with this for some time.

    The code below now works, it takes a list of words from Column A in Excel and adds the words to the custom dictionary.


    Sub addToDict()
    'Standard module code, like: Module1.
    'Add a list of words in Column "A" to the Custom Dictionary!
    Dim o_WordApp As Object, o_ActCustDict As Object
    Dim r_MyCell As Range
    Dim s_MyWord$, s_ActCustDictNm$
    Dim l_LastRow&, l_StartRow&

    '********************************************************************
    'The Row that the"Add to Dictionary" Word List Starts in!
    l_StartRow = 3
    '********************************************************************
    l_LastRow = ActiveSheet.Range("A65536").End(xlUp).Row
    s_MyMsg = "Current custom dictionary: " & s_ActCustDictNm & vbLf & "Added: "

    Set r_MyRng = ActiveSheet.Range(Cells(l_StartRow, 1), Cells(l_LastRow, 1))
    Set o_WordApp = GetObject(, "Word.Application")
    Set o_ActCustDict = o_WordApp.Application.CustomDictionaries.ActiveCustomDictionary
    s_ActCustDictNm = o_ActCustDict.Name

    Open o_ActCustDict.Path & "\" & o_ActCustDict.Name For Append As #1

    For Each r_MyCell In r_MyRng
    s_MyWord = r_MyCell.Value

    If Not IsEmpty(s_MyWord) Then
    Print #1, s_MyWord

    s_MyMsg = s_MyMsg & s_MyWord & ", "

    End If
    Next r_MyCell

    Close #1

    MsgBox s_MyMsg
    End Sub
    JSW: Try and try again: "The way of the Coder!"

  4. #4
    Board Regular
    Join Date
    Jun 2002
    Location
    New Jersey
    Posts
    318
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    WOW! Thank you both for all this assistance I will put the code in the spreadsheet and it sure looks like this will take care of the problem. A problem that has been bothering me since they installed this new version of Excel.

    thanks again

    Walt

  5. #5
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    This is an improvement on the code above. It now works if WORD is not currently Open.


    Sub addToDict()
    'Standard module code, like: Module1.
    'Add a list of words in Column "A" to the Custom Dictionary!

    Dim o_WordApp As Object
    Dim o_ActCustDict As Object
    Dim r_MyCell As Range, r_MyRng As Range
    Dim s_MyWord$, s_ActCustDictNm$, s_MyMsg$
    Dim l_LastRow&, l_StartRow&, n&

    '********************************************************************
    'The Row that the"Add to Dictionary" Word List Starts in!
    l_StartRow = 3
    '********************************************************************
    l_LastRow = ActiveSheet.Range("A65536").End(xlUp).Row

    Set r_MyRng = ActiveSheet.Range(Cells(l_StartRow, 1), Cells(l_LastRow, 1))

    Set o_WordApp = CreateObject("Word.Application")
    Set o_ActCustDict = o_WordApp.Application.CustomDictionaries.ActiveCustomDictionary
    s_ActCustDictNm = o_ActCustDict.Name
    s_MyMsg = "Current custom dictionary: " & s_ActCustDictNm & vbLf & "Added: "

    Open o_ActCustDict.Path & "\" & o_ActCustDict.Name For Append As #1

    For Each r_MyCell In r_MyRng
    s_MyWord = r_MyCell.Value
    If Not IsEmpty(s_MyWord) Then
    If Not Application.CheckSpelling(s_MyWord, CustomDictionary:=s_ActCustDictNm, IgnoreUppercase:=False) Then
    n = n + 1
    Print #1, s_MyWord
    s_MyMsg = s_MyMsg & s_MyWord & ", "
    End If
    End If
    Next r_MyCell

    Close #1
    o_WordApp.Quit

    If n > 0 Then
    MsgBox s_MyMsg
    Else
    MsgBox s_MyMsg & " None needed to be Added!"
    End If

    End Sub
    JSW: Try and try again: "The way of the Coder!"

  6. #6
    Board Regular
    Join Date
    Jun 2002
    Location
    New Jersey
    Posts
    318
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Joe Was, I hadn't noticed. I had outlook open when I tried the code so there weren't any problems. Worked great.

    How are you with counters?? I posed a question a few weeks ago but never got any bites. I have some code from someone that allows me to import .TXT files larger than the 65536 limit imposed by Excel. The counter can be set to the number of lines < 65536 you want and when that number is reached it creates a new TAB and continues importing them all over again. I need the counter to also have an =IF statement or something so I can control when it does break after the perdetermined number of lines set by the counter = some number. Here is the problem, by setting up only by some arbitrary stop line <65536 it can break at the wrong place. It can break lines of data about a person. In this case it is the pension checks a retiree gets one each and every month. So I would like to see all twelve or so lines about the one person before it broke to the next TAB. There are "blanks" between the data or there is a header page that repeats that has words like "NORTHERN". Any way to get this to work the way I have described, so I can keep all the persons data on one TAB and not have it start too near the end of one and force the remaining data onto the next??

    thanks

    Walt

  7. #7
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    75,112
    Post Thanks / Like
    Mentioned
    60 Post(s)
    Tagged
    6 Thread(s)

    Default

    Walt

    Can you start a new thread or post a link to the original?

    What I would suggest is just adding a simple check for the end/beginning of each record.

    But exactly how that would be done would depend on the current code.
    If posting code please use code tags.

  8. #8
    Board Regular
    Join Date
    Jun 2002
    Location
    New Jersey
    Posts
    318
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Norie,
    >Can you start a new thread or post a link to the original?

    can do! I think?
    http://www.mrexcel.com/board2/viewto...885&highlight=

    >What I would suggest is just adding a simple check for the end/beginning of each record.

    simple? maybe for people like you and Joe Was! I wish I had even a smidgen of your knowledge.

    >But exactly how that would be done would depend on the current code.
    looks something like this:
    Sub LargeFileImport()
    ' This will split a very large text file (FileName)
    ' Into multiple Text Files (sPath)
    ' Based on a set number of records (CounterMax)

    'Dimension Variables
    Dim Datafile As Variant
    Dim ResultStr As String
    Dim g As String
    Dim FileNum As Integer
    Dim Counter As Variant
    Dim CounterMax As Variant
    Dim sPath As String
    Dim FileCounter As Integer
    Dim FileName As String



    'Output File
    FileCounter = 1
    sPath = "C:\testing\temp_" & FileCounter & ".txt"
    'Number of Records in Each Text File
    CounterMax = 64500
    'Call Auto_Open
    'Ask User for File's Name
    Application.DefaultFilePath = ThisWorkbook.Path

    Datafile = Application.GetOpenFilename(Title:="Need to locate the Northern Trust Benefit Payment.TXT file. Try Pension Accounting\200X DB Plans... ")
    If Datafile = False Then
    MsgBox "Please help me find the location of the Northern Trust Benefit Payment.TXT file"
    Datafile = Application.GetOpenFilename(Title:="Please locate the Northern Trust Benefit Payment.TXT file")
    If Datafile = False Then
    Exit Sub
    End If
    End If
    ' Opens the data file and imports just the relevant columns
    'FileName = "C:\Account Analysis - (180 Char)_030106.txt"
    'Check for no entry
    FileName = Datafile
    'Get Next Available File Handle Number
    FileNum = FreeFile()
    'Open Text File For Input
    Open FileName For Input As #FileNum
    'Get Next Available File Handle Number
    g = FreeFile()
    'Open Text File For Output
    Open sPath For Output As #g
    'Turn Screen Updating Off
    'Application.ScreenUpdating = False
    'Set The Counter to 1
    Counter = 1

    'Loop Until the End Of File Is Reached
    Do While Seek(FileNum) <= LOF(FileNum)
    'Display Importing Row Number On Status Bar
    Application.StatusBar = "Importing Row " & _
    Counter & " of text file " & FileName
    'Store One Line Of Text From File To Variable
    Line Input #FileNum, ResultStr
    'Output One Line Of Text From Variable To File
    Print #g, ResultStr
    ResultStr = vbNullString

    'Check to See if we should start a new Output File
    If Counter Mod CounterMax = 0 Then
    'Close Current Output File
    Close #g
    'Open a New Ouput File
    FileCounter = FileCounter + 1
    sPath = "C:\testing\temp_" & FileCounter & ".txt"
    g = FreeFile()
    Open sPath For Output As #g
    End If
    'Increment the Counter By 1
    Counter = Counter + 1
    'Start Again At Top Of 'Do While' Statement
    Loop
    'Close The Open Text File
    Close #g
    Close #FileNum
    'Remove Message From Status Bar
    Application.StatusBar = False
    MsgBox "Great, that's Completed! Next step is to pull in the .TXT and convert it to .XLS Just say OK"
    Macro10

    End Sub


    then I have it working on the data by adding in some formulas to get the information in a useable format and then do the subtotals to get the sub totals and total totals.

    hope this makes some sense to you.

    thanks

    Walt

  9. #9
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    75,112
    Post Thanks / Like
    Mentioned
    60 Post(s)
    Tagged
    6 Thread(s)

    Default

    Walt

    Is there anything in the data that will determine when you would want to start a new file/tab?

    This is the code that currently decides whether or not to start a new file/tab.
    Code:
    If Counter Mod CounterMax = 0 Then 
         'Close Current Output File 
         Close #g 
         'Open a New Ouput File 
         FileCounter = FileCounter + 1 
         sPath = "C:\testing\temp_" & FileCounter & ".txt" 
         g = FreeFile() 
         Open sPath For Output As #g 
    End If
    You would probably replace the If statement with something like this.
    Code:
    If ResultStr = "Something that tells us to create a new file." Then
    You would probably have to rearrange some of the other code as well.

    Can you post some sample data?
    If posting code please use code tags.

  10. #10
    Board Regular
    Join Date
    Jun 2002
    Location
    New Jersey
    Posts
    318
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Yes Norie, sample data should be in the link I provided.

    http://www.mrexcel.com/board2/viewto...885&highlight=

    The posting some time back shows what a "sample" looks like. It contains names , social security numbers, addresses bank account info so I'm sure you understand why I can only show you a sample. For all intent and purpose it comes to me as if is a finished report ready to print, has the header and page numbers. I have not see at any time where the supplier of the report "Northern Trust" has displayed the individuals data on two pages so I'm thinking the words "Northern Trust" could be a good break-point.

    thanks

    Walt

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •