[CDR 2024] Автоматическое переименование файлов

[Иван 1965]

Здравствуйте, подскажите, как сделать автоматическое переименование файлов при экспорте. Экспорт и сохранение уже есть в макросе. Нужно, чтобы он читал, какие имена файлов уже есть в папке, и если они совпадают, то добавлял +1; например, создаём файл "Иванов", сохраняем через макрос, и в этот момент, вместо перезаписи или предупреждения, макрос проверяет, нет ли такого имени уже в папке, и если есть, называет "Иванов1", "Иванов2" и так далее.

 

[zollinger]

Заводи счетчик, формируй имя с этим значением счетчика, проверяй наличие, если есть, инкрементируй счетчик и по-новой формируй-проверяй, пока не окажется, что файла с таким именем нет

 

[Иван 1965]

Я новичек в vba можно кодом если не сложно

 

[zollinger]

Не, с дивана вставать лень. Обычный цикл for. Вон, такие вещи deepseek хорошо разъясняет, и бесплатно

 

[dastin]

Я новичек в vba

вот как ...

Экспорт и сохранение уже есть в макросе

... что за макрос?

 

[~RA~]

новичек

Какой такой чек?

 

[_MBK_]

Вон, такие вещи deepseek хорошо разъясняет, и бесплатно

Неужели его уже корелу научить успели?

 

[zollinger]

Неужели его уже корелу научить успели?

Но явно же он VBA знает, а тут уж совсем простейший вопрос

 

[_MBK_]

Насколько я помню, нейросети с кореловской моделью чудили изрядно

 

[mnemonix]

и до сих пор чудят

 

[zollinger]

Насколько я помню, нейросети с кореловской моделью чудили изрядно

А у него не про модель вопрос. Там с базой сложности, как я понимаю

 

[_MBK_]

А хотя да, чисто обращение с файловой системой.

 

[~RA~]

Можно доработать ваш макрос, добавив проверку существования файла перед сохранением. В VBA для CorelDRAW (или любого другого макроязыка) можно использовать Dir() для проверки наличия файла в папке.


Пример кода:

Sub ExportWithUniqueName()
    Dim folderPath As String
    Dim baseFileName As String
    Dim fullFileName As String
    Dim fileExt As String
    Dim fileIndex As Integer

    folderPath = "C:\ВашПуть\" ' Укажите папку для сохранения
    baseFileName = "Иванов" ' Основное имя файла
    fileExt = ".jpg" ' Расширение файла

    fullFileName = folderPath & baseFileName & fileExt
    fileIndex = 1

    ' Проверяем, существует ли файл, и при необходимости добавляем индекс
    Do While Dir(fullFileName) <> ""
        fullFileName = folderPath & baseFileName & fileIndex & fileExt
        fileIndex = fileIndex + 1
    Loop

    ' Здесь вставьте ваш код экспорта
    ActiveDocument.Export fullFileName, cdrJPEG
    MsgBox "Файл сохранён как: " & fullFileName, vbInformation
End Sub

Этот код проверяет, есть ли уже файл с таким именем, и если есть, добавляет к имени порядковый номер. Работает для любого расширения, просто измените fileExt.

 

[Акулыч]

Если заменить цикл с пред-условием на цикл с пост-условием, то можно избавиться от одной строки.

 

[~RA~]

Да, если использовать Do...Loop с пост-условием (Do...Loop While), то можно упростить код, убрав первоначальное присвоение fullFileName перед циклом.

Вот исправленный вариант:

Sub ExportWithUniqueName()

    Dim folderPath As String

    Dim baseFileName As String

    Dim fullFileName As String

    Dim fileExt As String

    Dim fileIndex As Integer



    folderPath = "C:\ВашПуть\" ' Укажите папку для сохранения

    baseFileName = "Иванов" ' Основное имя файла

    fileExt = ".jpg" ' Расширение файла



    fileIndex = 0



    Do

        If fileIndex = 0 Then

            fullFileName = folderPath & baseFileName & fileExt

        Else

            fullFileName = folderPath & baseFileName & fileIndex & fileExt

        End If

        fileIndex = fileIndex + 1

    Loop While Dir(fullFileName) <> ""



    ' Здесь вставьте ваш код экспорта

    ActiveDocument.Export fullFileName, cdrJPEG

    MsgBox "Файл сохранён как: " & fullFileName, vbInformation

End Sub

Теперь переменная fullFileName инициализируется прямо в цикле, и проверка Dir(fullFileName) выпо
лняется после первой итерации.

 

[zollinger]

Вообще, логично было бы передавать путь и имя (а может, и расширение) как параметры функции, а не как хард-кодед значения переменных

 

[~RA~]

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

Финальный вариант функции:
vba
Copy code
Function GetUniqueFileName(folderPath As String, baseFileName As String, fileExt As String) As String
Dim fullFileName As String
Dim fileIndex As Integer

fileIndex = 0

Do
If fileIndex = 0 Then
fullFileName = folderPath & baseFileName & fileExt
Else
fullFileName = folderPath & baseFileName & fileIndex & fileExt
End If
fileIndex = fileIndex + 1
Loop While Dir(fullFileName) <> ""

GetUniqueFileName = fullFileName
End Function
Использование в макросе:
vba
Copy code
Sub ExportWithUniqueName()
Dim folderPath As String
Dim baseFileName As String
Dim fileExt As String
Dim uniqueFileName As String

folderPath = "C:\ВашПуть\" ' Укажите путь
baseFileName = "Иванов" ' Имя файла
fileExt = ".jpg" ' Расширение

' Получаем уникальное имя файла
uniqueFileName = GetUniqueFileName(folderPath, baseFileName, fileExt)

' Экспортируем файл
ActiveDocument.Export uniqueFileName, cdrJPEG
MsgBox "Файл сохранён как: " & uniqueFileName, vbInformation
End Sub
Теперь функцию GetUniqueFileName можно использовать в других частях кода для любых файловых операций.

 

[zollinger]

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

Спойлер: Финальный вариант функции:

Финальный вариант функции:
vba
Copy code
Function GetUniqueFileName(folderPath As String, baseFileName As String, fileExt As String) As String
Dim fullFileName As String
Dim fileIndex As Integer

fileIndex = 0

Do
If fileIndex = 0 Then
fullFileName = folderPath & baseFileName & fileExt
Else
fullFileName = folderPath & baseFileName & fileIndex & fileExt
End If
fileIndex = fileIndex + 1
Loop While Dir(fullFileName) <> ""

GetUniqueFileName = fullFileName
End Function
Использование в макросе:
vba
Copy code
Sub ExportWithUniqueName()
Dim folderPath As String
Dim baseFileName As String
Dim fileExt As String
Dim uniqueFileName As String

folderPath = "C:\ВашПуть\" ' Укажите путь
baseFileName = "Иванов" ' Имя файла
fileExt = ".jpg" ' Расширение

' Получаем уникальное имя файла
uniqueFileName = GetUniqueFileName(folderPath, baseFileName, fileExt)

' Экспортируем файл
ActiveDocument.Export uniqueFileName, cdrJPEG
MsgBox "Файл сохранён как: " & uniqueFileName, vbInformation
End Sub
Теперь функцию GetUniqueFileName можно использовать в других частях кода для любых файловых операций.

Подозреваю, что в таком виде оно у ТСа не заработает и, похоже, он не поймет, почему

 

[zollinger]

Вот deepseek сгенерил функцию создания уникального имени

Function GetUniqueFileName(filePath As String, baseName As String, fileExtension As String) As String
    Dim counter As Long
    Dim fullPath As String
    Dim fileName As String
    
    ' Убедимся, что расширение начинается с точки
    If Left(fileExtension, 1) <> "." Then
        fileExtension = "." & fileExtension
    End If
    
    ' Инициализируем счетчик
    counter = 1
    
    ' Генерируем уникальное имя файла
    Do
        fileName = baseName & "_" & counter & fileExtension
        fullPath = filePath & "\" & fileName
        counter = counter + 1
    Loop While Dir(fullPath) <> ""  ' Проверяем, существует ли файл
    
    ' Возвращаем уникальное имя файла
    GetUniqueFileName = fileName
End Function

 

[~RA~]

Битва нейросетей?