。bas import Runtime Error 80070006句柄无效

问题描述 投票:2回答:1

尝试将.bas文件作为VBA项目中的模块导入时,出现Windows系统错误。我可以手动导入,也可以通过编程方式按名称导入,但是当我将其放入具有不同导入处理条件的循环中时,出现以下图片中的错误。

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

excel vba windows
1个回答
0
投票

每次有条不紊地更改每一行并运行该宏的简短版本后,我能够确定问题的根源。我无法解释是什么原因导致了“句柄无效”错误,但是我可以解释是什么原因为我解决了问题:

随着宏执行,如果它试图删除的“元素”对象当前未执行,则该方法将在执行过程中成功删除该元素。此后任何引用“ element”的行都将无效,因为该对象在项目中不再存在。

我注意到了这一点,因为我测试了以下代码。更改是我按名称导入了文件,但随后仅尝试使用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

那告诉我,删除元素后名称本身必须无效。我通过在删除元素后创建一个字符串变量来存储元素名称来解决该错误。这使我可以将相同的名称传递给import方法,再传递给消息框函数!

以下是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。您可以在工作簿项目中轻松创建一个单独的事件或子过程,以在其他时间重命名该模块。

我敢肯定,有更优雅的方法可以做到这一点,但是下面是一个工作簿事件,显示了我如何处理重命名问题:

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

我希望这对某人有帮助!

© www.soinside.com 2019 - 2024. All rights reserved.