exceljames
New Member
- Joined
- Jun 27, 2017
- Messages
- 1
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
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
