עזרה | יצירת קבצי TTS -לטריוויה בשפת VBA

צבי 10

אני רוצה להכניס את כל השאלות והתשובות, לקובץ וורד/... והוא יצור "קובץ הקראה" לכל השאלות והתשובות אוטומטית.
תכל'ס הוא פותח קבצים חדשים, עם השמות שהגדרתי אבל לא שומר אותם.
אולי מישהו יוכל לעזור לי עם הקוד:

Sub Macro1()
'
' Macro1 Macro
'
'
'בודק האם קיימת תיקייה לקבצים. אם לא צור תיקייה חדשה.
If Len(Dir("c:\Trivia", vbDirectory)) = 0 Then
   MkDir "c:\Trivia"
End If
If Len(Dir("c:\Trivia\1", vbDirectory)) = 0 Then
   MkDir "c:\Trivia\1"
End If
If Len(Dir("c:\Trivia\1\000", vbDirectory)) = 0 Then
   MkDir "c:\Trivia\1\000"
End If
'מגדיר את הספרייה הנוכחית ל- C:
ChDir "c:\Trivia\1\000"
'שומר כל שורה בקובץ, בתור קובץ שאלה, ו-4 תשובות
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
     Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Application.Keyboard (1033)
    ActiveDocument.SaveAs2 FileName:="Q.tts", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
        False, LineEnding:=wdCRLF, AddBiDiMarks:=False, CompatibilityMode:=0
    Windows("Split files1").Activate
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
     Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
     Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Application.Keyboard (1033)
    ActiveDocument.SaveAs2 FileName:="A.tts", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
        False, LineEnding:=wdCRLF, AddBiDiMarks:=False, CompatibilityMode:=0
    Windows("Split files1").Activate
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
     Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Application.Keyboard (1033)
    ActiveDocument.SaveAs2 FileName:="B.tts", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
        False, LineEnding:=wdCRLF, AddBiDiMarks:=False, CompatibilityMode:=0
    Windows("Split files1").Activate
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
       Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
     Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Application.Keyboard (1033)
    ActiveDocument.SaveAs2 FileName:="C.tts", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
        False, LineEnding:=wdCRLF, AddBiDiMarks:=False, CompatibilityMode:=0
    Windows("Split files1").Activate
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
       Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
     Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Application.Keyboard (1033)
    ActiveDocument.SaveAs2 FileName:="D.tts", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=65001, InsertLineBreaks:=False, AllowSubstitutions:= _
        False, LineEnding:=wdCRLF, AddBiDiMarks:=False, CompatibilityMode:=0
    Windows("Split files1").Activate
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
    
End Sub

נפתר עזרה | יצירת קבצי TTS -לטריוויה בשפת VBA