.bas import Ошибка выполнения 80070006 Неверный дескриптор - PullRequest
2 голосов
/ 14 апреля 2020

Я получаю системную ошибку windows при попытке импортировать файл .bas в качестве модуля в проект VBA. Я могу импортировать вручную, и я могу программно импортировать по имени, но когда я помещаю его в al oop с другими условиями обработки импорта, я получаю ошибку на рисунке ниже.

enter image description here

Вот пример моего тестового кода для проверки того, что мои методы работают так, как я подозреваю. Эта версия завершается успешно:

Sub test()

Dim thisBook As String
Dim filePath As String
filePath = "O:\Quality Repositories\Process Checks Workbook Repository\"
thisBook = "Process Control Workbook.xlsm"

For Each element In Workbooks(thisBook).VBProject.VBComponents
    If element.Name = "MacroModule" Then
        If Dir(filePath & "MacroModule" & ".bas") <> "" Then
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & "MacroModule" & ".bas")
            MsgBox ("MacroModule" & ".bas imported")
        End If
    End If
Next element

End Sub

А вот дисфункциональная версия, которая обрабатывает все другие типы плиток, которые мне может понадобиться импортировать. Он успешно перезаписывает всю обработку событий объектов Sheet и Workbook, но останавливается из-за системной ошибки при первом импорте .frm или .bas.

Sub import_mods()

Dim filePath As String
Dim thisBook As String
Dim fso As FileSystemObject
Dim ts As TextStream
Dim S As String
filePath = "O:\Quality Repositories\Process Checks Workbook Repository\"
thisBook = "Process Control Workbook.xlsm"

For Each element In Workbooks(thisBook).VBProject.VBComponents
    If element.Type = 1 Then 'Modules
        If Dir(filePath & element.Name & ".bas") <> "" Then
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & element.Name & ".bas")
            MsgBox (element.Name & ".bas imported")
        End If
    ElseIf element.Type = 3 Then 'Forms
        If Dir(filePath & element.Name & ".frm") <> "" Then
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & element.Name & ".frm")
            MsgBox (element.Name & ".frm imported")
        End If
    ElseIf element.Type = 2 Then 'Class Modules
        If Dir(filePath & element.Name & "cls") <> "" Then
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & element.Name & ".cls")
            MsgBox (element.Name & ".cls imported")
        End If
    ElseIf element.Type = 100 Then 'Sheet or Workbook modules
        If Dir(filePath & element.Name & ".cls") <> "" Then
            Set fso = New FileSystemObject
            Set ts = fso.OpenTextFile(filePath & element.Name & ".cls", ForReading)
            Do While Not ts.AtEndOfStream
                If ts.line <= 9 Then
                    ts.SkipLine
                Else
                    S = S & ts.ReadLine & vbCrLf
                End If
            Loop
            With element.CodeModule
                .DeleteLines 1, .CountOfLines
                .InsertLines 1, S
            End With
            MsgBox (element.Name & " imported" & vbCrLf & S)
            S = vbNullString
            ts.Close
        End If
    End If
Next element

End Sub

Сообщения форума, которые я видел с этой ошибкой обычно относятся к сайтам и языкам кодирования, которые я не использую. Я надеюсь, что кто-то может предложить некоторые предложения о том, почему одна версия дает сбой в отличие от другой. Насколько я могу судить, они функционально эквивалентны. Я был бы очень рад получить предложения о том, как мне избежать этой ошибки и получить бонусные баллы, если кто-то может объяснить мне, что такое дескриптор.

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

enter image description here

1 Ответ

0 голосов
/ 16 апреля 2020

После методического изменения каждой строки по одной и запуска короткой версии макроса, я смог определить источник проблемы. Я не могу объяснить, что вызывает ошибки «Неверный дескриптор», но я могу объяснить, что решило проблему для меня:

При выполнении макроса, если объект «элемент», который он пытается удалить, не является в настоящее время выполняется, метод успешно удаляет этот элемент в середине выполнения. После этого любая строка, которая ссылается на «элемент», будет недействительной, поскольку объект больше не существует в проекте.

Я заметил это, потому что я тестировал следующий код. Изменение заключается в том, что я импортировал файл по имени, но затем просто попытался создать окно сообщения, используя element.Name. что привело к выделению строки MsgBox с ошибкой «неверный дескриптор»:

For Each element In Workbooks(thisBook).VBProject.VBComponents
    If element.Name = "OutsourceModule" Then
        If Dir(filePath & element.Name & ".bas") <> "" Then
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.Import _
                (filePath & "OutsourceModule" & ".bas")
            MsgBox (element.Name & ".bas imported")
        End If
    End If
Next element

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

Ниже приведена совершенно успешная версия контроля версий для книги Excel. Он использует имена текущих объектов в проекте для поиска в указанном местоположении файлов для экспортируемых файлов с тем же именем. Если он находит совпадения в этом расположении, он заменяет формы, модули классов и модули импортированными версиями из этого местоположения. Если он находит файлы .cls (экспортированные из объектов листа и книги), он удаляет текст в этих объектах и ​​заменяет его текстом файлов с такими же именами.

Sub import_mods()

Dim filePath As String
Dim thisBook As String
Dim fso As FileSystemObject
Dim ts As TextStream
Dim S As String
filePath = "O:\Quality Repositories\Process Checks Workbook Repository\"
thisBook = "Process Control Workbook.xlsm"

Dim newString As String

For Each element In Workbooks(thisBook).VBProject.VBComponents
    If element.Type = 1 Then 'Modules
        If Dir(filePath & element.Name & ".bas") <> "" Then
            newString = element.Name
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & newString & ".bas")
            MsgBox (newString & ".bas imported")
        End If
    ElseIf element.Type = 3 Then 'Forms
        If Dir(filePath & element.Name & ".frm") <> "" Then
            newString = element.Name
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & newString & ".frm")
            MsgBox (newString & ".frm imported")
        End If
    ElseIf element.Type = 2 Then 'Class Modules
        If Dir(filePath & element.Name & "cls") <> "" Then
            newString = element.Name
            Workbooks(thisBook).VBProject.VBComponents.Remove element
            Workbooks(thisBook).VBProject.VBComponents.import _
                (filePath & newString & ".cls")
            MsgBox (newString & ".cls imported")
        End If
    ElseIf element.Type = 100 Then 'Sheet or Workbook modules
        If Dir(filePath & element.Name & ".cls") <> "" Then
            Set fso = New FileSystemObject
            Set ts = fso.OpenTextFile(filePath & element.Name & ".cls", ForReading)
            Do While Not ts.AtEndOfStream
                If ts.line <= 9 Then
                    ts.SkipLine
                Else
                    S = S & ts.ReadLine & vbCrLf
                End If
            Loop
            With element.CodeModule
                .DeleteLines 1, .CountOfLines
                .InsertLines 1, S
            End With
            MsgBox (element.Name & " imported" & vbCrLf & S)
            S = vbNullString
            ts.Close
        End If
    End If
Next element

End Sub

Одна вещь, на которую следует обратить внимание в том, что модуль, в котором вы храните этот макрос, не будет удален во время выполнения, потому что он все еще работает. В этом случае импортированная версия этого макроса будет переименована в moduleName1. Вы можете очень легко создать отдельное событие или подпроцедуру в своем проекте рабочей книги, чтобы переименовать этот модуль в другое время.

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

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

For Each element In Workbooks("Process Control Workbook.xlsm").VBProject.VBComponents

    If element.Type = 1 Then 'Modules
        element.Name = Replace(element.Name, "Module1", "Module")
    ElseIf element.Type = 3 Then 'Forms
        element.Name = Replace(element.Name, "1", "")
    ElseIf element.Type = 2 Then 'Class Modules
        element.Name = Replace(element.Name, "Module1", "Module")
    ElseIf element.Type = 100 Then 'Sheet or Workbook modules
    End If
Next element

End Sub

Надеюсь, это кому-нибудь поможет!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...