'Code by Mahipal Padigela
'Open Microsoft Word,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Replace the file paths where necessory to suit yours
'Close VBA Editor and run this Macro from the Word window(Alt+F8)
'Note: Make sure you have a few Section Breaks in your document to test the code
Sub Generate()
Dim rng As Range
Dim strName As String
Dim strSource As String
Dim strFileTitle As String
Dim i As Integer
i = 1
strSource = "C:\test.doc"
strFileTitle = "test.doc"
Application.ScreenUpdating = False
Documents.Open strSource 'open the word document
For i = 1 To ActiveDocument.Sections.Count
Set rng = ActiveDocument.Sections(i).Range
rng.Copy 'copy the paragraph
Documents.Add 'create a new word document
Selection.Paste 'paste into the new document
ActiveDocument.Sentences(1).Select ' select 1st line for filename
strName = Selection.Sentences(1).Text
strName = Replace(strName, Chr(13), "") 'replace enter key if any
strName = Replace(strName, Chr(9), "") 'replace tab chars if any
strName = Replace(strName, Chr(10), "") 'replace newline chars if any
strName = Trim(Replace(strName, ":", "")) & ".doc" 'replace any colons and trim the string
ActiveDocument.SaveAs "C:\" & strName 'save the new document
ActiveDocument.Close 'close the document
Windows(strFileTitle).Activate 'switch to the main document window
Next i
Windows(strFileTitle).Close
Application.ScreenUpdating = True
Set rng = Nothing
End Sub
|
