Website Copy Paste code in Excel VBA (Could you check my code for any computer crashes?)

[aerostress82]

Hello everyone,
I've been dealing with Excel VBA for around 7 years whenever the task would call for it.

Below code is to open websites and save the data "as a text file". It looks like it is working fine. But as you know, if some bits of data is left somewhere, it will end up crashing your computer in the "long term" - which happened to me on multiple computers so far. I'm not a programmer, but have used Excel VBA (& Patran Programming) to speed things up for the team at all times.


Having introduced my background, could you check the below code to see if there is any way to refresh the cache of the computer without interrupting this task.
Every input seems to be reset, but I've used the below VBA references for the first time and I'm just not so sure that I've covered every single cache leak:
- Microsoft Scripting Runtime,
- Microsoft HTML Object Library,
- Microsoft Internet Controls.

(Also, please feel free to use this code for your own purposes as well. I think this is not out there right away, but is very good for retrieving websites in *.txt format)



As you may realize I've used a trick to get over the readyState = 4 problem I had, by putting an if and go to 367. Also, not sure, if this is hurting the computer.. If readyState tends to get stuck at 3 for at least 1 minute, then I'm forcing the VBA browser to shut down and restart that particular task without interrupting the algorithm

(Thanks in advance for any kind of input. If you are not familiar, that's OK too. Just use the code as is. First input is "datEr". An example of dater variable is "_2014.09.25", which stands for September 9th 2014. Second input is the website address as Address_text. A sample is "

http://www.eng-tips.com/

")

Yes, the Code:
--------------------------------------------


Sub ExplorerCont()


Dim IExp As SHDocVw.InternetExplorer
Dim hDoc As MSHTML.HTMLDocument
Dim fsoFSO As Scripting.FileSystemObject
Dim fsoFile As Scripting.TextStream

Dim datEr As String
Dim DayEr As String
Dim MonthEr As String
Dim YearEr As String
'input line

Sheets("websites").Select

a = 237
i = 1

pathway = ActiveWorkbook.Path


Do While Not Cells(a - 1 + i, 8) = ""

datEr = Cells(a - 1 + i, 8)

DayEr = Right(datEr, 2) * 1
Month_text = Mid(datEr, 7, 2) * 1
YearEr = Mid(datEr, 2, 4) * 1

pathway_new = pathway & "\" & datEr

MkDir pathway_new

Cells(1, 5) = DayEr & "/" & Month_text & "/" & YearEr

For b = 1 To 33
Address_text = Cells(b, 3)

367

Set IExp = New SHDocVw.InternetExplorer
IExp.Navigate Address_text

cTime = Now + TimeValue("00:01:00")
Do Until (IExp.readyState = 4 And Not IExp.Busy)
If Now < cTime Then
DoEvents
Else
IExp.Quit
Set IExp = Nothing
GoTo 367
End If
Loop

Set hDoc = IExp.Document
Set fsoFSO = New Scripting.FileSystemObject
Set fsoFile = fsoFSO.CreateTextFile(Filename:=pathway_new & "\" & b & ".txt")

fsoFile.WriteLine Text:=hDoc.Body.outerText
fsoFile.Close

IExp.Quit

Set IExp = Nothing
Set hDoc = Nothing
Set fsoFSO = Nothing
Set fsoFile = Nothing

Next b

i = i + 1

Loop

End Sub


-------------------------------------------------------------------------------------------------------------------
Spaceship!!


Aerospace Engineer, M.Sc. / Aircraft Stress Engineer with 7 years of experience
(United States)