Code Automation Error Causing Code to Stop

Question

My code is running fine until the 81st iteration loop. There are over 1000 rows that need to go through this loop. The code then randomly stops. There is some sort of automation error. Please assist!

 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

This code is meant to append long strings together to create file paths that follow a certain naming convention. What you are looking at is the execution step in which the concatinated paths (that have been written to an HTM file format) are written to the cell.

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

On Line: 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

Upon some further application it looks as though my Programs menu (ctrl+alt+delete) processes has a number of instances of internet explorer open. Could this be related? — Coding Novice
– Coding Novice, Commented Aug 4, 2015 at 13:52
That is most likely the issue. Kill them and i bet it will work. — MatthewD
– MatthewD, Commented Aug 4, 2015 at 13:55
Try rebooting your computer for a fresh start if you have not done so yet. — MatthewD
– MatthewD, Commented Aug 4, 2015 at 16:19

MatthewD · Accepted Answer · 2015-08-04 18:11:18Z

I moved the stuff to where it should be. Looks like you had a few bits in multiple spots.

Took the IE stuff out of this sub.

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

Added IE dim and set in this sub

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

You are my hero! I really appreciate you sticking with me for this whole time to figure it out. Thank you so much!

MatthewD · Accepted Answer · 2015-08-04 17:30:16Z

1

You need to add a reference to the Micorsoft InterNet Controls. In the VBA IDE go to the tools menu, select "Micorsoft InterNet Controls".

Look at how it is getting declared.

Dim IE as Object

And try setting it like this instead of how you are doing it.

Set IE = New InternetExplorerMedium

IE.Quit will end the the application instance. Place that at the end of you code so your instances don't pile up.

IE.Quit

Also unset the object

Set IE = Nothing

You want to do that after you use IE but before you loop back to create another (if you are looping during creation).

So all together this works for me.

Dim ie As InternetExplorer
Set ie = New InternetExplorerMedium

'Do some stuff here.

ie.Quit
Set ie = Nothing

I see the process start. iexplorer.exe *32 and then it goes away at the quit.

edited Aug 4, 2015 at 17:30

answered Aug 4, 2015 at 13:56

MatthewD

6,8215 gold badges24 silver badges44 bronze badges

13 Comments

Coding Novice Over a year ago

This did not quit the application however. I am not sure why because intuitively it seems like it should work.

MatthewD Over a year ago

Look at where you are putting it. It may have to do with scope.

MatthewD Over a year ago

Also unset the ID object.

MatthewD Over a year ago

Also, have you declared IE? Dim IE as Object

Coding Novice Over a year ago

So IE is Set as a CreateObject("Internetexplorer.Application"). I will post the entire code so that you can see what is going on here. Essentially I have one module for concatination, and the second for overall code

|

MatthewD · Accepted Answer · 2015-08-04 18:56:40Z

1

After you get this working, i would recommend, at the very top of ALL your code you should put

Option Explicit

It will not work after you do this. It will make you declare all your variables.

So where you use RowCount = 2 it will say RowCount is not declared. You will have to

Dim RowCount as Long
RowCount = 2

It will be a bit of a learning curve, but in the end it helps to not have bugs in your code.

edited Aug 4, 2015 at 18:56

answered Aug 4, 2015 at 18:14

MatthewD

6,8215 gold badges24 silver badges44 bronze badges

1 Comment

Coding Novice Over a year ago

I will keep this in mind for the next codes that I start! Thank you!

Collectives™ on Stack Overflow

Code Automation Error Causing Code to Stop

3 Answers 3

2 Comments

13 Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

13 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related