ก๊วนซอฟท์แวร์ </softganz> SoftGang (Gang Software)

โจทย์ : ให้นำเข้าข้อมูลสู่ไฟล์ Microsoft Excel โดยดึงมาจากเว็บไซท์ แยกข้อมูลออกมาและนำแต่ละรายการไปใส่ไว้ใน row/col ต่าง ๆ

แนวทาง :

1. เขียน VB Script เพื่อดึงข้อมูลจากหน้าเว็บ (มีฟังก์ชั่นอยู่แล้ว)
2. วนลูปเพื่อเขียนข้อมูลแต่ละรายการ ลงไปใน cell ที่ต้องการ

ตัวอย่าง VB Script code

Dim IE As Object
Sub Website()

    Dim Doc As Object, lastRow As Long, tblTR As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True

    navigate:
    IE.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"

    Do While IE.readystate <> 4: DoEvents: Loop

    Set Doc = CreateObject("htmlfile")
    Set Doc = IE.document

    If Doc Is Nothing Then GoTo navigate

    Set txtDtBegin = Doc.getelementbyid("txtDateBegin")
    txtDtBegin.Value = Format(Sheet1.Range("B3").Value, "dd.MM.yyyy")

    Set txtDtEnd = Doc.getelementbyid("txtDateEnd")
    txtDtEnd.Value = Format(Sheet1.Range("B4").Value, "dd.MM.yyyy")

    lastRow = Sheet1.Range("B65000").End(xlUp).row
    If lastRow < 5 Then Exit Sub

    For i = 5 To lastRow
        Set company = Doc.getelementbyid("lstCompany")
        For x = 0 To company.Options.Length - 1
            If company.Options(x).Text = Sheet1.Range("B" & i) Then
            company.selectedIndex = x

            Set btnCompanyAdd = Doc.getelementbyid("btnCompanyAdd")
            btnCompanyAdd.Click
            Set btnCompanyAdd = Nothing

            wait
            Exit For
            End If
        Next
    Next

    wait

    Set btnSubmit = Doc.getelementbyid("btnSubmit")
    btnSubmit.Click

    wait

    Set tbldgFunds = Doc.getelementbyid("dgFunds")
    Set tblTR = tbldgFunds.getelementsbytagname("tr")

    Dim row As Long, col As Long
    row = 1
    col = 1

    On Error Resume Next

    For Each r In tblTR

    If row = 1 Then
        For Each cell In r.getelementsbytagname("th")
            Sheet2.Cells(row, col) = cell.innerText
            col = col + 1
            Next
            row = row + 1
            col = 1
            Else
            For Each cell In r.getelementsbytagname("td")
            Sheet2.Cells(row, col) = cell.innerText
            col = col + 1
            Next
            row = row + 1
            col = 1
            End If
        Next

    IE.Quit
    Set IE = Nothing

    MsgBox "Done"

End Sub

Sub wait()
    Application.wait Now + TimeSerial(0, 0, 10)
    Do While IE.readystate <> 4: DoEvents: Loop
End Sub

ปล. ไว้ค่อยลองแล้วได้ผลอย่างไร จะมาเขียนต่อนะครับ

ที่มา Import web data in excel using VBA