Dictionary from one rtf file

[Taby]

There is any solution for making a dictionary from one rtf file?

TWImporter can do a new module only from folder with many files.

[csterg]

I have some MS Word macros that do split big files in smaller ones, but I do customize them every time, they are not generic. Would these help?
Costas

[Taby]

Maybe.

May you send me them to my mail?

[csterg]

I will post here as attachments since more people may be interested,
Costas

[csterg]

This is some code that will break a big rtf file on every paragraph that starts with a Hebrew letter.
You need to find a proper 'separator', e.g. something that identifies the beginning of each topic (e.g. bold, font-size, etc, MS Word can locate almost anything)
HTH,
Costas

Code: Select all

Sub SplitSingleDoc()
Dim i, j, v As Integer
Dim r As Range
Dim PS() As Long
Dim s As String
  Selection.HomeKey Unit:=wdStory
  ReDim Preserve PS(1) 'selections beginnings

  j = 1
  For i = 1 To ActiveDocument.Paragraphs.Count
    'Debug.Print ActiveDocument.Paragraphs(i).Format.FirstLineIndent
    
    'read the first word
    Set r = ActiveDocument.Range( _
        Start:=ActiveDocument.Paragraphs(i).Range.Start, _
        End:=ActiveDocument.Paragraphs(i).Range.Start)
    r.Expand Unit:=wdWord ', Count:=1, Extend:=wdExtend
    s = r.Text
    v = AscW(Mid(s, 1, 1))
    If (v >= 1425 And v <= 1524) Or (v >= 64286 And v <= 64335) Then
        PS(j) = r.Start
        j = j + 1
        ReDim Preserve PS(j)
    End If
    'Debug.Print s
    'Debug.Print AscW(Mid(s, 1, 1))
  Next i
  
  
    For i = 1 To UBound(PS)
      Selection.Start = PS(i)
      
      'filename is the hebrew word
      Selection.Expand Unit:=wdWord
      s = Selection.Text
      's = Trim(s)
      
      'set the selection
      Selection.Start = PS(i)
      If i < UBound(PS) Then
        Selection.End = PS(i + 1)
      Else
        Selection.MoveEnd wdStory, 1
      End If
      Selection.Copy
      Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
      NewDocName = ActiveDocument.Name
      Selection.PasteAndFormat (wdPasteDefault)
              
      Selection.HomeKey Unit:=wdStory 'move to beginning of doc
      
      ChangeFileOpenDirectory "h:\dev\work\"
      ActiveDocument.SaveAs FileName:=s, FileFormat:=wdFormatRTF, _
            AddToRecentFiles:=False
       Windows.Application.ActiveWindow.Close
Continue:
    Next i
  
End Sub

[Taby]

Thanks