Альтернативный способ удаления файла без необходимости добавления ссылки на MS Scripting Runtime

На чтение 3 мин Опубликовано 17.09.2024

Ответ на этот вопрос указывает на то, что для избежания ошибки необходимо добавить ссылку на MS Scripting Run-time.

Я использовал эту методику для удаления файла в своем коде, но так как я знаю, что он будет использоваться на нескольких компьютерах, на которых эта ссылка не будет включена, я вижу два выбора:

Использовать другую методику для удаления существующего файла.
Найти способ загрузить файл ссылки при открытии файла.

Этот саб связан с кнопкой ActiveX на листе

Sub Createbackupfile()

Dim strCurrentName As String
Dim strCurrentPathAndName As String
Dim strCurrentPath As String
Dim strPreviousFilename As String

    strCurrentName = ThisWorkbook.Name
    strCurrentPathAndName = ThisWorkbook.FullName
    strCurrentPath = Replace(strCurrentPathAndName, strCurrentName, "")

    NewPath = "OldForecasts\"

    With ThisWorkbook
        .SaveAs Filename:=strCurrentPath & StrNewPath & strCurrentName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End With

    With New FileSystemObject
        If .FileExists(CurrentPathAndName) Then
            .deleteFile CurrentPathAndName
        End If
    End With

End Sub

#Вопрос#

Какой альтернативный подход можно использовать вместо New FileSytemObject

Содержание

Ответ
Объяснение изменений:
Примечания:

Ответ

Чтобы удалить файл в VBA без необходимости добавления ссылки на библиотеку MS Scripting Runtime, вы можете воспользоваться встроенными средствами VBA, используя объект Kill для удаления файла. Мы изменим ваш код, избавившись от использования FileSystemObject. Вот переопределенный код с использованием метода Kill:

Sub Createbackupfile()

    Dim strCurrentName As String
    Dim strCurrentPathAndName As String
    Dim strCurrentPath As String
    Dim strPreviousFilename As String
    Dim strNewPath As String

    strCurrentName = ThisWorkbook.Name
    strCurrentPathAndName = ThisWorkbook.FullName
    strCurrentPath = Replace(strCurrentPathAndName, strCurrentName, "")

    strNewPath = "OldForecasts\"

    ' Сохранение текущей рабочей книги в новой директории
    With ThisWorkbook
        .SaveAs Filename:=strCurrentPath & strNewPath & strCurrentName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End With

    ' Удаление предыдущего файла, если он существует
    On Error Resume Next ' Игнорируем ошибку, если файл не существует
    Kill strCurrentPathAndName
    On Error GoTo 0 ' Включаем стандартную обработку ошибок

End Sub

Объяснение изменений:

Удаление FileSystemObject: Мы исключили объект FileSystemObject и вместо этого используем встроенную функцию Kill, которая служит для удаления файлов в VBA.
Обработка ошибок: Используем On Error Resume Next, чтобы избежать ошибки, если файл, который мы пытаемся удалить, не существует. После выполнения Kill мы возвращаем стандартное поведение обработки ошибок с помощью On Error GoTo 0.

Примечания:

Убедитесь, что путь в strNewPath корректен, и каталог "OldForecasts" существует, иначе возникает ошибка при попытке сохранить файл в этой директории.

Теперь ваш код будет работать на всех компьютерах без необходимости добавлять ссылку на MS Scripting Runtime, что делает его более универсальным.