После методического изменения каждой строки по одной и запуска короткой версии макроса, я смог определить источник проблемы. Я не могу объяснить, что вызывает ошибки «Неверный дескриптор», но я могу объяснить, что решило проблему для меня:
При выполнении макроса, если объект «элемент», который он пытается удалить, не является в настоящее время выполняется, метод успешно удаляет этот элемент в середине выполнения. После этого любая строка, которая ссылается на «элемент», будет недействительной, поскольку объект больше не существует в проекте.
Я заметил это, потому что я тестировал следующий код. Изменение заключается в том, что я импортировал файл по имени, но затем просто попытался создать окно сообщения, используя 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
Надеюсь, это кому-нибудь поможет!