Форум по VBA и MS Office

Доброго времени суток.
ТЗ:
есть вордовский документ из него копируем первую строку (название будущего документа), и сохраняем в определенную папку (она постоянная).

Мой код:

Sub Макрос1()

    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Copy
    ChangeFileOpenDirectory "F:\Папка\1"
    ActiveDocument.SaveAs2 FileName:=Selection.Text, FileFormat _
        :=wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True _
        , WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, Encoding:=1251, InsertLineBreaks:=False, _
        AllowSubstitutions:=False, LineEnding:=wdCRLF, CompatibilityMode:=0
End Sub

[свернуть]

Происходит ошибка: error 5487, ошибка доступа к файлу. Через переменную пробовал, ошибка остается.
Если имя файла константа, то работает, но мне такое не подходит.

Предположу, что проблема в том, что вы пытаетесь добавить в имя файла недопустимые символы: на конце абзаца есть невидимый символ "конец абзаца", видимо, он попадает в имя файла.
Правильно вот так:
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveEnd Unit:=wdCharacter, Count:=-1

И не нужно копировать. Эта строка не нужна:
Selection.Copy

И можно не использовать эту строку:
    ChangeFileOpenDirectory "F:\Папка\1"

Вместо неё измените вот так следующую строку:
    ActiveDocument.SaveAs2 FileName:="F:\Папка\1\" & Selection.Text, FileFormat _
        :=wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True _
        , WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, Encoding:=1251, InsertLineBreaks:=False, _
        AllowSubstitutions:=False, LineEnding:=wdCRLF, CompatibilityMode:=0


Таким образом код будет такой:

Sub Макрос1()

    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
   
    ActiveDocument.SaveAs2 FileName:="F:\Папка\1\" & Selection.Text, FileFormat _
        :=wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True _
        , WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, Encoding:=1251, InsertLineBreaks:=False, _
        AllowSubstitutions:=False, LineEnding:=wdCRLF, CompatibilityMode:=0
   
End Sub

Спасибо, помогло.