ปัญหาในการโหลดไฟล์ HTML พร้อมกันเยอะๆ

[nogoitems]

สวัสดีครับ ผมมือใหม่ Excel
อยากจะสอบถามปัญหานี้ครับ

Code: Select all

Function gethtmltext(URL As String, savepath As String) As String

Dim ie As Object, objDoc As Object
Dim strURI As String
strURI = URL
Set ie = CreateObject("internetexplorer.application")
ie.navigate strURI
'Wait for page to load!
Do
If ie.readyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop

Set objDoc = ie.document

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(savepath, True, True)
oFile.WriteLine objDoc.body.innerHTML 
oFile.Close
Set fso = Nothing
Set oFile = Nothing
gethtmltext = objDoc.body.innerHTML

ie.Quit
Set objDoc = Nothing
Set ie = Nothing
End Function

ฟังก์ชั่นนี้สำหรับ เอา HTML Code จากเว็บมาเซฟลงไฟล์ text
แล้วผมไปรัน ฟังก์ชั่นนี้ ใน
For ให้วนหลายๆลูพ เพื่อเก็บ หน้า อื่นๆของเว็บนี้ ลงไฟล์ Text
แต่ไฟล์ Text ที่ ได้จากแต่ละหน้านั้น บางที ก็ซํ้ากันเป็นหน้าที่ 1 หมด
บางทีก็เหมือนจะเซฟมาได้ปกติดี แต่ หน้าที่ 15 กลับ กลายเป็นของหน้า 1 ซะได้ แล้วก็เหมือนจะปกติไปอีก ซัก3-4หน้า ก็ไป ซํ้ากับหน้า1ใหม่
แก้ไขอย่างไรดีครับผม ผมเคยลองหน่วงเวลาในแต่ละ ลูพแล้วก็ไม่เป็นผล
แต่เคยลองดึง ข้อมูล จากเว็บอยู่สองลิงค์ ในเวลาไล่เลี่กัน หลังจาก ดึงข้อมูลจากลิงค์ที่ 1มาเซฟเสร็จ
จะดึงข้อมูลจาก URL ลิงค์สอง ต้องกด รันๆ ซํ้าๆกันหลายๆทีๆ หรือ ไม่ก็รอเวลาซักพัก ไฟล์ที่เซฟได้ถึงจะเป็นของลิงค์ที่ 2

[snasui]

เนื่องจากไม่ได้แจ้งว่า Save แยกเป็นแต่ละไฟล์หรือไฟล์เดียวแต่นำข้อมูลมาวางต่อเนื่องกันไป สำหรับด้านล่างเป็นตัวอย่างการวางข้อมูลต่อเนื่องกันไปในไฟล์เดียวครับ

Code: Select all

Function gethtmltext(URL As String, savepath As String) As String

    Dim ie As Object, objDoc As Object
    Dim strURI As String
    strURI = URL
    Set ie = CreateObject("internetexplorer.application")
    ie.navigate strURI
    'Wait for page to load!
    
    DoEvents
    Do
        If ie.readyState = 4 Then
            ie.Visible = False
            Exit Do
        End If
    Loop
    
    Set objDoc = ie.document
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Dir(savepath) <> "" Then
        Dim ff As Long
        ff = FreeFile
        Open savepath For Append As #ff
        Print #ff, StrConv(objDoc.body.innerHTML, vbUnicode)
        Close #ff
    Else
        Dim oFile As Object
        Set oFile = fso.CreateTextFile(savepath, True, True)
        oFile.writeline objDoc.body.innerHTML
        oFile.Close
    End If

    Set fso = Nothing
    Set oFile = Nothing
    gethtmltext = objDoc.body.innerHTML
    
    ie.Quit
    Set objDoc = Nothing
    Set ie = Nothing
End Function