VBA Question: How can I run my macro indefinitely?

[exceljames]

Hi, I want to run the code below forever, and it works only for a few hours. After a few hours, I will get a run time error and this line will be highlighted: "Set myIE = CreateObject("InternetExplorer.Application")" It is an object-defined error. Am I using too much memory somewhere? Is there a way I could run this for 15+ hours at a time?
Thank you.



Sub schedule()
TimeToRun = Now + TimeValue("00:00:01")
Application.OnTime TimeToRun, "one"
End Sub


Sub one()
If Range("C3") <> "" Then

'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C3").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend

'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D3").Select
Selection.Copy
Range("E3").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
For Each htmlEle1 In myIEDoc.getElementsByTagName("div")
If htmlEle1.className = "mergerByDate" Then
Range("D3").Value = htmlEle1.innerText
Exit For
End If
Next htmlEle1
Set htmlEle1 = Nothing

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing

If (Range("F3").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = Range("C3").Value

On Error Resume Next
With OutMail
.To = Range("G3").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR EC WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

End If

ActiveWorkbook.Save
Call two

End Sub
Sub two()
If Range("C4") <> "" Then

'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C4").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend


'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D4").Select
Selection.Copy
Range("E4").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
Dim st As String
For Each htmlEle1 In myIEDoc.getElementsByTagName("table")
If htmlEle1.className = "responstable" Then
st = st + htmlEle1.innerText
End If
Next htmlEle1
Set htmlEle1 = Nothing
Range("D4").Value = st
st = vbNullString

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing


If (Range("F4").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = Range("C4").Value


On Error Resume Next
With OutMail
.To = Range("G4").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR PSCDC WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

End If

ActiveWorkbook.Save
Call three

End Sub
Sub three()
If Range("C5") <> "" Then
'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C5").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend


'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D5").Select
Selection.Copy
Range("E5").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
For Each htmlEle1 In myIEDoc.getElementsByTagName("div")
If htmlEle1.className = "view-content" Then
Range("D5").Value = htmlEle1.innerText
Exit For
End If
Next htmlEle1
Set htmlEle1 = Nothing


If (Range("F5").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = Range("C5").Value


On Error Resume Next
With OutMail
.To = Range("G5").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR FTC PRESS RELEASE WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing
End If

Call four


End Sub
Sub four()
If Range("C6") <> "" Then
'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C6").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend


'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
Dim st As String
For Each htmlEle1 In myIEDoc.getElementsByTagName("td")
If htmlEle1.className = "small" Then
st = st + htmlEle1.innerText
End If
Next htmlEle1
Set htmlEle1 = Nothing
Range("D6").Value = st
st = vbNullString



If (Range("F6").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = Range("C6").Value


On Error Resume Next
With OutMail
.To = Range("G6").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR LEVEL THREE SEC WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing
End If

ActiveWorkbook.Save
Call five

End Sub
Sub five()
If Range("C7") <> "" Then
'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C7").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend


'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D7").Select
Selection.Copy
Range("E7").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
Dim st As String
For Each htmlEle1 In myIEDoc.getElementsByTagName("td")
If htmlEle1.className = "small" Then
st = st + htmlEle1.innerText
End If
Next htmlEle1
Set htmlEle1 = Nothing
Range("D7").Value = st
st = vbNullString


If (Range("F7").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = Range("C3").Value


On Error Resume Next
With OutMail
.To = Range("G7").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR SEC ALERE WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing
End If

Call six
End Sub
Sub six()
If Range("C8") <> "" Then
'Turn Off Alerts
Application.DisplayAlerts = False

Dim myIE As Object
Dim myIEDoc As Object

'Start Internet Explorer
Set myIE = CreateObject("InternetExplorer.Application")

'if you want to see the window set this to True
myIE.Visible = False

'Now we open the page we'd like to use as a source for information
myIE.Navigate Range("C8").Value

'We wait for the Explorer to actually open the page and finish loading
While myIE.Busy
DoEvents
Wend


'Now lets read the HTML content of the page
Set myIEDoc = myIE.Document

'Copy Paste old listings
Range("D8").Select
Selection.Copy
Range("E8").Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Then we'll get something from the inner page content by using the ID
Dim htmlEle1 As Object
Dim st As String
For Each htmlEle1 In myIEDoc.getElementsByTagName("td")
If htmlEle1.className = "small" Then
st = st + htmlEle1.innerText
End If
Next htmlEle1
Set htmlEle1 = Nothing
Range("D8").Value = st
st = vbNullString


If (Range("F8").Value = "Yes") Then

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Send an alert (email) if there is an update
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = Range("C8").Value


On Error Resume Next
With OutMail
.To = Range("G8").Value
'.CC = ""
'.BCC = ""
.Subject = "ALERT FOR SEC AT&T WEBSITE!!!"
.body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.send 'or use .Display
End With
On Error GoTo 0

OutApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
strbody = vbNullString

End If

myIE.Quit
Set myIE = Nothing
Set myIEDoc = Nothing
End If

ActiveWorkbook.Save
Call schedule

End Sub

 

[NickRed18]

Makes it readable. [ code]your code here[ /code]
(no spaces before code and /code)
https://www.mrexcel.com/forum/misc.php?do=bbcode#thread