Редактирующий макрос

[mephist]

Мне очень нужен макрос,который будет редактировать документ (с расширенем .doc): нужно, 1)заменить некоторый слова, 2)сохранить его с расширением docx, 3) Удалить исходный файл с раширенем .doc 4)Отключить предупреждения о том, что я сохраняю в книге без поддержки макросов.
Написал код:

Sub Delete_0_Files()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    'On Error Resume Next
    ActiveDocument.RemovePersonalInformation = False
    ActiveDocument.Range.Find.Execute "0 ôàéë(à,îâ)^0013", , , , , , , , , "", wdReplaceAll
    ActiveDocument.Range.Find.Execute "D:\head\Q2 2009\", , , , , , , , , "", wdReplaceAll
    ActiveDocument.SaveAs FileName:=ActiveDocumentPath & "\1.docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    'Delete ThisDocumentPath & "\1.doc"
    Application.DisplayAlerts = True
End Sub

ActiveDocumentPath вместо полного пути текущего файла выдает мне только диск. Подскажите пожалуйста, как сохранить в той же директории, что и текущий файл?
'Delete ThisDocumentPath & "\1.doc" Вообще не работает, ибо я не знаю команды которой можно удалять. А какой можно?
Я код писал интуитивно, по аналогии, посмотрите пожалуйста на тупые ошибки.

[Sasha_Smirnov]

Как сказано книге для «чайников»,

Kill <путь к файлу>

(и если путь содежит пробелы, он должен быть в "" и с \\ вместо \).

Попробуйте также свойство

ActiveDocument.Fullname

У меня, правда, оно выдаёт то же, что и

ActiveDocument.Name

[viter.alex]

Сам макрос должен находиться в шаблоне, например Normal.dotm. После поиска и замены нужно не сохранять документ, а создать новый, скопировать в него содержимое старого и сохранить. Старый файл нужно закрыть, а затем удалить.
Примерный код (не проверял):

Sub Delete_0_Files()
  Dim oDocOld As Document
  Dim oDocNew As Document
  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  Dim sPath As String, sFullName As String
  
  Set oDocOld = ActiveDocument
  oDocOld.RemovePersonalInformation = False
  oDocOld.Range.Find.Execute "0 oaee(a,ia)^0013", , , , , , , , , "", wdReplaceAll
  oDocOld.Range.Find.Execute "D:\head\Q2 2009\", , , , , , , , , "", wdReplaceAll
  oDocOld.Content.Copy 'Копируем в буфер содержимое старого файла
  
  sFullName = oDocOld.FullName 'Полное имя старого документа
  sPath = oDocOld.Path 'Полный путь к старому документу
  
  oDocOld.Close True 'Закрываем старый документ  
  Set oDocOld = Nothing

  Set oDocNew = Documents.Add 'Добавляем документ
  With oDocNew
    .Range.Paste 'Вставляем в него содержимое старого
    .SaveAs sPath & "\1.docx", wdFormatDocument, addtorecentfiles:=False 'Сохраняем его под новым именем.
  End With
  
  Kill sFullName 'Удаляем старый файл с диска
  Set oDocNew = Nothing
  Application.DisplayAlerts = True
End Sub

[mephist]

Спасибо большое! Очень помогло!
Sasha_Smirnov Да, я чайник!
viter.alex У вас очень хороший код, но мне все таки понятнее свой(хотя если вы видите явные огрехи в моем коде скажите,пожалуйста), поэтому в итоге получилось следующее:

 Dim sFullName As String
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    On Error Resume Next
    sFullName = ActiveDocument.FullName
    ActiveDocument.RemovePersonalInformation = False
    ActiveDocument.Range.Find.Execute "0 ôàéë(à,îâ)^0013", , , , , , , , , "", wdReplaceAll
    ActiveDocument.Range.Find.Execute "D:\head\Q2 2009\", , , , , , , , , "", wdReplaceAll
    ActiveDocument.SaveAs FileName:=sFullName & ".docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", addtorecentfiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    Kill sFullName
    Application.DisplayAlerts = True

Единственно только результат теперь выглядит "ИМЯ.doc.docx", а в целом все работает правильно.
Не могли бы мне помочь избавиться от букв .doc????

[viter.alex]

Самые явные «огрехи»:

1. Сократите строку поиска и замены. Вас среди всех параметров этой функции интересуют три. Вот их и нужно указать. Это сделает код читаемым, тем более, что Вы «чайник». Итак, замените ActiveDocument.Range.Find.Execute "0 ôàéë(à,îâ)^0013", , , , , , , , , "", wdReplaceAll на ActiveDocument.Range.Find.Execute FindText:= "0 ôàéë(à,îâ)^0013", ReplaceWith = "", Replace = wdReplaceAll. Во втором поиске и замене то же самое;
2. При сохранении тоже самое. Оставьте только нужные Вам параметры:ActiveDocument.SaveAs FileName:=sFullName & ".docx", FileFormat:= wdFormatXMLDocument, AddToRecentFiles := False

А чтобы избавиться от расширения в конце полного имени файла, запишите вместо sFullName такую конструкцию:Mid(sFullName, 1, InStrRev(sFullName, ".") - 1). Эта конструкция возвращает часть строки, начиная с первого символа, и до символа перед первой точкой, считая с конца строки.

Ну а чтобы не вылетало сообщение, что вы собираетесь сохранить документ в формате без макросов, то просто запускайте этот макрос не из документа, который сохраняете, а из шаблона.

[mephist]

Спасибо большое, очень дельно написано. Количество параметров меня правда не пугает, а вот за функцию обработки имени огромное спасибо.