vba - 代码自动化错误导致代码停止

Question

我的代码运行良好，直到第 81 次迭代循环。有超过 1000 行需要通过此循环。然后代码随机停止。存在某种自动化错误。请协助!

 sb.Delimiter = "_"
    Set fs = CreateObject("Scripting.FileSystemObject")
        Set myHtmlFile = fs.CreateTextFile("C:\Users\wsherow\Temp\MyHTMLfile.htm", True)
        myHtmlFile.WriteLine (sb.ToString())
        myHtmlFile.Close

        Set IE = CreateObject("Internetexplorer.Application")
        IE.Visible = False

此代码旨在将长字符串附加在一起以创建遵循特定命名约定的文件路径。您正在查看的是连接路径(已写入 HTM 文件格式)写入单元的执行步骤。

Sub concentiateMAIN()
RowCount = 2
Dim ie As InternetExplorer
Set ie = New InternetExplorerMedium
Do While Cells(RowCount, 2) <> 0
    concentiate
    Range("IV" & RowCount).Value = sb
    With CreateObject("Scripting.FileSystemObject")
        Range("A" & RowCount) = .OpenTextFile("C:\Users\wsherow\Temp\MyHTMLfile.htm").ReadAll()
    End With
    RowCount = RowCount + 1
    ie.Quit
    Set ie = Nothing
Loop

End Sub

在线: Set IE = CreateObject("Internetexplorer.Application")

Sub concentiate()
    Dim CellValue As String
    Dim sb
    Set sb = New Class1
    '14NM
    sb.Append "14NM"
    'WID___________________________________________________________________________
    If Range("HG" & RowCount) = "Width" Then
        sb.Append "WID"
        If Range("HH" & RowCount) = "Line" Then
            sb.Append "LINE"
        End If
        If Range("HH" & RowCount) = "Space" Then
            sb.Append "SPACE"
        End If
        sb.Append Range("IC" & RowCount)
        sb.Append Range("HN" & RowCount)
        sb.Append Range("HO" & RowCount)
        If Range("HY" & RowCount) = "Linear" Then
            sb.Append "LINEAR"
        End If
        If Range("HY" & RowCount) = "Threshold" Then
            sb.Append "THD"
        End If
        sb.Append "TH"
        sb.Append Range("II" & RowCount)

    End If
    'ER___________________________________________________________________________
    If Range("HG" & RowCount) = "Edge Roughness" Then
        sb.Append "ER"
        If Range("HH" & RowCount) = "Line" Then
            sb.Append "LINE"
        End If
        If Range("HH" & RowCount) = "Space" Then
            sb.Append "SPACE"
        End If
        sb.Append Range("IC" & RowCount)
        sb.Append Range("HN" & RowCount)
        sb.Append Range("HO" & RowCount)
        If Range("HY" & RowCount) = "Linear" Then
            sb.Append "LINEAR"
        End If
        If Range("HY" & RowCount) = "Threshold" Then
            sb.Append "THD"
        End If
        sb.Append "TH"
        sb.Append Range("II" & RowCount)
    End If
    'WR___________________________________________________________________________
    If Range("HG" & RowCount) = "Width Roughness" Then
        sb.Append "WR"
        If Range("HH" & RowCount) = "Line" Then
            sb.Append "LINE"
        End If
        If Range("HH" & RowCount) = "Space" Then
            sb.Append "SPACE"
        End If
        sb.Append Range("IC" & RowCount)
        sb.Append Range("HN" & RowCount)
        sb.Append Range("HO" & RowCount)
        If Range("HY" & RowCount) = "Linear" Then
            sb.Append "LINEAR"
        End If
        If Range("HY" & RowCount) = "Threshold" Then
            sb.Append "THD"
        End If
        sb.Append "TH"
        sb.Append Range("II" & RowCount)
    End If
    'ELL___________________________________________________________________________
    If Range("HG" & RowCount) = "Elipse" Then
        sb.Append "ELL"

        If Range("HG" & RowCount) = "Inner Diameter" Then
            sb.Append "INNERD"
        End If
        If Range("HG" & RowCount) = "Outer Diamter" Then
            sb.Append "OUTERD"
        End If
        If Range("HJ" & RowCount) = "Diameter" Then
            sb.Append "DIA"
        End If
        If Range("HJ" & RowCount) = "X Diameter" Then
            sb.Append "XDIA"
        End If
        If Range("HJ" & RowCount) = "Y Diameter" Then
            sb.Append "YDIA"
        End If
        If Range("HJ" & RowCount) = "Major Axis" Then
            sb.Append "MAG"
        End If
        If Range("HJ" & RowCount) = "Minor Axis" Then
            sb.Append "MIN"
        End If
        sb.Append Range("HO" & RowCount)
        If Range("HY" & RowCount) = "Linear" Then
            sb.Append "LINEAR"
        End If
        If Range("HY" & RowCount) = "Differential" Then
            sb.Append "DIFF"
        End If
        If Range("HY" & RowCount) = "Threshold" Then
            sb.Append "THD"
        End If
        sb.Append "TH"
        sb.Append Range("II" & RowCount)

    End If
    'DIA___________________________________________________________________________
    If Range("HG" & RowCount) = "Diameter(Hole)" Then
        sb.Append "DIA"
        If Range("HG" & RowCount) = "Inner Diameter" Then
            sb.Append "INNERD"
        End If
        If Range("HG" & RowCount) = "Outer Diamter" Then
            sb.Append "OUTERD"
        End If
        '_______


        If Range("HI" & RowCount) = "Multi Point" Then
            sb.Append "MP"
            sb.Append Range("HN" & RowCount)
            sb.Append Range("HO" & RowCount)
            If Range("HY" & RowCount) = "Linear" Then
                sb.Append "LINEAR"
            End If
            If Range("HY" & RowCount) = "Differential" Then
               sb.Append "DIFF"
            End If
            If Range("HY" & RowCount) = "Threshold" Then
                sb.Append "THD"
            End If
            sb.Append Range("IC" & RowCount)
        End If
        If Range("HI" & RowCount) = "Single" Then
            sb.Append "SINGLE"
            If Range("HY" & RowCount) = "Linear" Then
                sb.Append "LINEAR"
            End If
            If Range("HY" & RowCount) = "Differential" Then
               sb.Append "DIFF"
            End If
            If Range("HY" & RowCount) = "Threshold" Then
               sb.Append "THD"
            End If
            sb.Append Range("IF" & RowCount)
        End If
        If Range("HI" & RowCount) = "Radial" Then
            sb.Append "RAD"
            If Range("HJ" & RowCount) = "Diameter" Then
                sb.Append "DIA"
            End If
            If Range("HJ" & RowCount) = "X Diameter" Then
                sb.Append "XDIA"
            End If
            If Range("HJ" & RowCount) = "Y Diameter" Then
                sb.Append "YDIA"
            End If
            If Range("HJ" & RowCount) = "Major Axis" Then
                sb.Append "MAG"
            End If
            If Range("HJ" & RowCount) = "Minor Axis" Then
                sb.Append "MIN"
            End If
            sb.Append Range("HM" & RowCount)
            If Range("HY" & RowCount) = "Linear" Then
                sb.Append "LINEAR"
            End If
            If Range("HY" & RowCount) = "Differential" Then
               sb.Append "DIFF"
            End If
            If Range("HY" & RowCount) = "Threshold" Then
               sb.Append "THD"
            End If
            sb.Append Range("IC" & RowCount)
        End If
        sb.Append "TH"
        sb.Append Range("II" & RowCount)
    End If
        '______

    sb.Delimiter = "_"
    Set fs = CreateObject("Scripting.FileSystemObject")
        Set myHtmlFile = fs.CreateTextFile("C:\Users\wsherow\Temp\MyHTMLfile.htm", True)
        myHtmlFile.WriteLine (sb.ToString())
        myHtmlFile.Close

        Set IE = CreateObject("Internetexplorer.Application")
        IE.Visible = False
        IE.Navigate "C:\Users\wsherow\Temp\MyHTMLfile.htm"
        IE.Quit
    Set IE = Nothing
End Sub

Answer 1

您需要添加对 Micorsoft Internet Controls 的引用。在 VBA IDE 中，进入工具菜单，选择“Micorsoft Internet Controls”。

看看它是如何被宣布的。

Dim IE as Object

并尝试像这样设置它，而不是你是怎么做的。

Set IE = New InternetExplorerMedium

IE.Quit 将结束应用程序实例。将其放在代码的末尾，这样您的实例就不会堆积起来。

IE.Quit 

同时取消设置对象

Set IE = Nothing

您想在使用 IE 之后但在循环返回创建另一个之前执行此操作(如果您在创建期间循环)。

所以这一切都对我有用。

Dim ie As InternetExplorer
Set ie = New InternetExplorerMedium

'Do some stuff here.

ie.Quit
Set ie = Nothing

我看到这个过程开始了。 iexplorer.exe *32 然后它在退出时消失。