代码自动化错误导致代码停止
我的代码运行良好，直到第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 此代码旨在将长string附加在一起以创build遵循特定命名约定的文件path。 你正在看的是执行步骤，其中连接的path（已被写入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
我把东西移到了应该的位置。 看起来你有多个点位。
把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昏暗和设置在这个分
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
您需要添加对Micorsoft InterNet控件的引用。 在VBA IDE中进入工具菜单，select“Micorsoft InterNet Controls”。
看看它是如何得到宣布。
Dim IE as Object
尝试像这样设置，而不是如何做。
Set IE = New InternetExplorerMedium
IE.Quit将结束应用程序实例。 把你的代码放在最后，这样你的实例就不会堆积起来。
IE.Quit
还取消设置对象
Set IE = Nothing
在使用IE之后但是在循环创build另一个（如果在创build期间循环）之前，您希望这样做。
所以这一切都为我工作。
Dim ie As InternetExplorer Set ie = New InternetExplorerMedium 'Do some stuff here. ie.Quit Set ie = Nothing
我看到过程开始。 iexplorer.exe * 32，然后在退出时消失。
你得到这个工作后，我会build议，在所有你的代码的顶部，你应该把
Option Explicit
你这样做后不行。 它会让你声明所有的variables。
所以在你使用RowCount = 2的地方，它会说RowCount没有被声明。 你不得不
Dim RowCount as Long RowCount = 2
这将是一个学习曲线，但最终它有助于没有错误的代码。