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控件的引用。在VBA IDE中，转到工具菜单，选择＆＃34; Micorsoft InterNet Controls＆＃34;。

看看它是如何被宣布的。

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然后它就退出了。

Answer 2

我将这些东西移到应该的位置。看起来你在多个位置都有一些位。

从这个子目录中取出IE的东西。

Sub concentiateMAIN()
    RowCount = 2

    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

添加了IE dim并在此子

中设置

Sub concentiate()
Dim IE As InternetExplorer
Dim CellValue As String
Dim sb
Set sb = New Class

'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 = New InternetExplorerMedium
'Set IE = CreateObject("Internetexplorer.Application")
IE.Visible = False
IE.Navigate "C:\Users\wsherow\Temp\MyHTMLfile.htm"
IE.Quit
Set IE = Nothing
End Sub

Answer 3

在你完成这项工作之后，我会建议你在所有代码的最顶层放置

Option Explicit

执行此操作后无效。它会让你声明所有变量。

因此，如果您使用RowCount = 2，则会声明RowCount未声明。你必须

Dim RowCount as Long
RowCount = 2

这将是一个学习曲线，但最终它有助于在您的代码中没有错误。

导致代码停止的代码自动化错误

3 个答案: