Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   Application.FileSearch (http://forum.oszone.net/showthread.php?t=342012)

phx447 31-08-2019 07:34 2886095
Application.FileSearch
 
День добрый. Возникла проблема с макросом при переходе с Office 2003 на 2007. Ошибка выходит на Application.FileSearch и как я понял, из поиска в интернете, Application.FileSearch в Office 2007 и выше отключен.
Я не программист и прошу помощи в решении проблемы.
Ошибка выходит на этом месте:

CheckExist:
With Application.FileSearch
.FileName = LastTxtName & ".txt"
.LookIn = ActiveDocument.Path
.Execute

While .Execute > 0

Incrementor = Incrementor + 1
If Incrementor < 10 Then
MatchLetters = 8
Else
MatchLetters = 7
End If

LastTxtName = Left (LastTxtName, MatchLetters - 1) & Incrementor

GoTo CheckExist

Wend
End With

FullLastTxtName = ActiveDocument.Path & "\" & LastTxtName & ".txt"

End Sub

Iska 31-08-2019 10:41 2886103
phx447, что должен делать приведённый Вами кусок кода?

DJ Mogarych 31-08-2019 10:55 2886107
Четвёртая ссылка вот здесь: https://www.google.ru/search?q=Application.FileSearch

Там есть решение: https://answers.microsoft.com/en-us/...5-0a83eb6bf984

phx447 31-08-2019 13:51 2886133
Iska, вот что делает
` А такой LLLLLL[][i].txt - файл имеется?
CheckExist:
`Если такой же (или следующий, или схожий по первым буквам) *.txt файл уже есть в этой папке`
With Application.FileSearch
.FileName = LastTxtName & ".txt"
.LookIn = ActiveDocument.Path
.Execute

While .Execute > 0

Incrementor = Incrementor + 1
`Поддерживается до 100 файлов`
If Incrementor < 10 Then
MatchLetters = 8 `(7 букв + 1 цифра)
Else
MatchLetters = 7 ` (6 букв + 2 цифра)
End If

LastTxtName = Left (LastTxtName, MatchLetters - 1) & Incrementor

` А такой LLLLLL[][i].txt - файл имеется?
GoTo CheckExist

Wend
End With

`Коннектим к файлу в транслите расширение *.txt
FullLastTxtName = ActiveDocument.Path & "\" & LastTxtName & ".txt"

End Sub

DJ Mogarych, я в гугле искал, но я не знаю или точнее не понимаю, как воспользоваться ответами, которые там даны.

Iska 31-08-2019 15:24 2886150
phx447, я не про комментирование кода, я не этого просил от Вас. Что должен делать код? Я не понимаю его предназначение. Я хочу, чтобы Вы описали задачу, для решения которой был создан данный код.

phx447 31-08-2019 15:34 2886152
Iska, данный код макросом в office 2003 проверяет текст на наличие лишних пробелов, заменяет некоторые символы на нужные, выравнивает текст по ширине и сохраняет измененный *.doc файл в *.txt. Предварительно проверив папку на наличие схожих по названию файлов при сохранении.

Iska 31-08-2019 15:52 2886155
Цитата:
Цитата phx447
Предварительно проверив папку на наличие схожих по названию файлов при сохранении. »
Расшифруйте, пожалуйста, подробнее. Что значит «схожих по названию»? Для чего проверяет?

phx447 31-08-2019 18:45 2886164
Цитата:
Цитата Iska (Сообщение 2886155)
Цитата:
Цитата phx447
Предварительно проверив папку на наличие схожих по названию файлов при сохранении. »
Расшифруйте, пожалуйста, подробнее. Что значит «схожих по названию»? Для чего проверяет?
Схожих по названию, значит идентичных, одинаковых. Например повторно применяя этот макрос на файле text.doc, то на этапе сохранения он определит, что уже имеется файл text.txt и макрос этот файл сохранит как text 1.txt.

Iska 31-08-2019 19:48 2886174
Цитата:
Цитата phx447
повторно применяя этот макрос на файле text.doc, то на этапе сохранения он определит, что уже имеется файл text.txt и макрос этот файл сохранит как text 1.txt. »
Я этого не вижу по приведённому Вами коду.

В общем, насколько я понимаю, Вам нужна функция, которая для каталога, где расположен активный документ, и указанного имени файла вернёт первое доступное имя файла, построенное по определённому принципу.
Код:
Option Explicit

Function GetFirstFreeName(strFileName As String)
    Dim objFSO As Object
   
    Dim strBaseFileName As String
    Dim strFullFileName As String
    Dim iCount As Integer
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    strBaseFileName = objFSO.GetBaseName(strFileName)
    strFullFileName = objFSO.BuildPath(ActiveDocument.Path, strBaseFileName & ".txt")
   
    iCount = 1
   
    Do While objFSO.FileExists(strFullFileName)
        iCount = iCount + 1
        strFullFileName = objFSO.BuildPath(ActiveDocument.Path, strBaseFileName & " " & CStr(iCount) & ".txt")
    Loop
   
    GetFirstFreeName = strFullFileName
End Function
т.е., например, для активного документа C:\Мои проекты\0274\Doc1.doc и переданного имени файла text.doc последовательно будут возвращаться имена:
Код:
C:\Мои проекты\0274\text.txt
C:\Мои проекты\0274\text 2.txt
C:\Мои проекты\0274\text 3.txt
C:\Мои проекты\0274\text 3.txt
и т.д. Так?

megaloman 01-09-2019 15:24 2886254
Цитата:
Цитата Iska
Что должен делать код? Я не понимаю его предназначение. »
Напрягу воображение:
ИМХО, это отрывок макроса в WORD, пробую (для себя!) описать его назначение:
Есть некие переменные, начальное значение определёно где-то выше:
LastTxtName - имя файла без расширения
Incrementor - счетчик для повторяющихся имен
В результате работы этого куска макроса длина имени LastTxtName+Пробел+Incrementor должно быть не более 8 символов, LastTxtName урезается.
Получившееся имя ActiveDocument.Path & "\" & LastTxtName & ".txt" не должно дублировать имеющееся имя файла.
Вот вариант для замены Вашего куска:
Код:
LastTxtName = "ABCDEFGHIJKLMN"


Incrementor = 0
ActiveDocumentPath = ActiveDocument.Path + "\"
Do
    If Incrementor = 0 Then
        TxtName = Left(LastTxtName, 6)
    Else
        TxtName = Left(LastTxtName, 7 - Len(CStr(Incrementor))) + " " + CStr(Incrementor)
    End If
    FullLastTxtName = ActiveDocumentPath + TxtName + ".txt"
    D = Dir(FullLastTxtName)
    If D = "" Then Exit Do
    Incrementor = Incrementor + 1
Loop


MsgBox """" + FullLastTxtName + """"
Зачеркнутые строки мне были нужны для отладки - Вы их удалте.
Incrementor = 0 - не знаю, нужно или нет, если эта переменная выше приведенного куска где-то определялась, то эту строку надо удалить.
Не очень понимаю, какое имя должно получиться при Incrementor = 0. Я сделал для отладочного имени ABCDEF.txt
В принципе, начальное значение Incrementor может быть не 0, а любое допустимое >0, например, 1 (первое имя при этом будет ABCDEF 1.txt).
Максимальная величина Incrementor в отладочном имени "A 999999.txt. Надеюсь, хватит.

Iska 01-09-2019 16:31 2886265
Вот за это я и люблю коллективный разум!

phx447 02-09-2019 19:43 2886408
megaloman, Iska возможно ваши варианты и подходят. Макрос на них не стопорится, теперь ошибка выходит на :

'Сохраняем в ОЕМ (DOS) кодировке
'Save file with new extension
ActiveDocument.SaveAs FileName:=FullLatTxtName, _
FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, Encoding:=866, InsertLineBreaks:=True, AllowSubstitutions:=True, _
LineEnding:=wdCRLF

megaloman 02-09-2019 21:26 2886416
phx447,
Каюсь, нагло списал сохранение документа из автозаписи макроса.
Код:
LastTxtName = "ABCDEFGHIJKLMN"

Incrementor = 0
ActiveDocumentPath = ActiveDocument.Path + "\"
Do
    If Incrementor = 0 Then
        TxtName = Left(LastTxtName, 6)
    Else
        TxtName = Left(LastTxtName, 7 - Len(CStr(Incrementor))) + " " + CStr(Incrementor)
    End If
    FullLastTxtName = ActiveDocumentPath + TxtName + ".txt"
    D = Dir(FullLastTxtName)
    If D = "" Then Exit Do
    Incrementor = Incrementor + 1
Loop

MsgBox """" + FullLastTxtName + """"

ActiveDocument.SaveAs2 FileName:=FullLastTxtName, _
    FileFormat:=wdFormatText, _
    LockComments:=False, _
    Password:="", _
    AddToRecentFiles:=True, _
    WritePassword:="", _
    ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, _
    SaveNativePictureFormat:=False, _
    SaveFormsData:=False, _
    SaveAsAOCELetter:=False, _
    Encoding:=866, _
    InsertLineBreaks:=False, _
    AllowSubstitutions:=True, _
    LineEnding:=wdCRLF, _
    CompatibilityMode:=0

phx447 07-09-2019 17:54 2887023
megaloman, на строке CompatibilityMode:=0 выходит Run-time error `13`: Type mismatch

megaloman 07-09-2019 20:13 2887033
Вложений: 1
phx447, возможно, проблема в совместимости, у меня Word 2010
Во первых, если не убирать MsgBox """" + FullLastTxtName + """", там получается внятное имя файла? Если нормальное, то:
Сделайте как я:
откройте макрос или удалите или закоментируйте все строки
Код:
'ActiveDocument.SaveAs2 FileName:=FullLastTxtName, _
'    FileFormat:=wdFormatText, _
'    LockComments:=False, _
'    Password:="", _
'    AddToRecentFiles:=True, _
'    WritePassword:="", _
'    ReadOnlyRecommended:=False, _
'    EmbedTrueTypeFonts:=False, _
'    SaveNativePictureFormat:=False, _
'    SaveFormsData:=False, _
'    SaveAsAOCELetter:=False, _
'    Encoding:=866, _
'    InsertLineBreaks:=False, _
'    AllowSubstitutions:=True, _
'    LineEnding:=wdCRLF, _
'    CompatibilityMode:=0
Закройте макрос. Сохраните файл.
Далее в ленте: Вид -> Макросы (треугольничек под надписью) -> Запись макроса -> Запомните имя макроса -> Птичка Макрос доступен для этого документа -> OK
Делаем: Файл -> Сохранить как -> Тип файла обычный текст -> имя файла можете сделать любым -> Сохранить документ в этом формате ->
http://forum.oszone.net/attachment.p...1&d=1567875088
-> Макросы (треугольничек под надписью) -> Остановить запись
Откройте записанный макрос.
Получится нечто похожее на вот это
(у меня имя файла было "qertyuio.txt")
Код:
    ActiveDocument.SaveAs2 FileName:="qertyuio.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=866, InsertLineBreaks:=False, AllowSubstitutions:=True, _
        LineEnding:=wdCRLF, CompatibilityMode:=0

Скопируйте получившееся у Вас (по сравнению со мной может что - то отличаться), вставьте в текст основного макроса, замените выделенное мной на FullLastTxtName.
Сохраните файл как: тип файла *.docm можно с первоначальным, до изменения макроса, именем.
Тестируйте полученное.

phx447 08-09-2019 08:24 2887059
megaloman, вроде макрос работает, но с несколькими проблемами.
Первая - это каждый документ после применения макроса сохраняется с именем "FullLastTxtName", если со строки FileName:= убрать все, то макрос не работает. А по задумке после применения документ должен сохраняться с именем первоначального документа, но в транслите.
Вторая - это после применения макроса, при следующем открытии Word нужно снова выносить макрос на панель, чтобы его применить

megaloman 08-09-2019 08:33 2887061
Цитата:
если не убирать MsgBox """" + FullLastTxtName + """", там получается внятное имя файла?
ActiveDocument.SaveAs2 FileName:=FullLastTxtName, ..............
FullLastTxtName - без кавычек, это не имя файла, это переменная, где хранится полное имя файла, которое отображается в MsgBox


Время: 03:41.

Время: 03:41.
© OSzone.net 2001-