Sửa macro get data from web

huybo · 31/8/16

Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = _
"URL;http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Tại ô a1(sheet1) e để 1 đường link web. sau đó làm macro để copy link tại ô a1(sheet1) đó và paste vào Address của get data from web để lấy dữ liệu về sheet2. Mục đích của e là muốn ô a1 là ô e có thể thay thế 1 đường link bất kỳ nào khác và chạy macro để load dữ liệu về theo đường link mới, nhưng macro chỉ nhận duy nhất 1 đường link ban đầu e tạo macro. Mọi người giúp e chỉnh sửa đoạn code trên với nhé.

HeSanbi · 17/9/19

phananhvusv đã viết:
Mấy anh chị cho em hỏi về cách lấy thông tin từ 1 trang web mà mình phải đăng nhập thì code như thế nào ạ?
VD: trong trang "https://www.giaiphapexcel.com", em cần đăng nhập và lấy số tin nhắn như trong hình. Do cái chỗ hiển thị số tin nhắn đó không có ID, nên em ko biết phải lấy thế nào. Mong được giúp đỡ.

PHP:

Sub Test_GetPostGPE()
  Debug.Print GetPostGPE("******", "*******")
End Sub

Function GetPostGPE&(Account$, Pass$)
  Dim Obj As Object, Doc As Object
  Dim IE As Object, DD As Object
  Const Url = "https://www.giaiphapexcel.com/diendan/account/account-details"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Visible = True
  IE.Navigate Url
  Do Until IE.readyState = 4: DoEvents: Loop
  Application.Wait (Now + TimeSerial(0, 0, 1))
  Do Until IE.readyState = 4: DoEvents: Loop
  Set Doc = IE.document
  Set Obj = Doc.getElementsByClassName("p-body-pageContent")(0).getElementsByClassName("input")
  Obj(0).Value = Account
  Obj(1).Value = Pass
  Doc.getElementsByClassName("button button--primary button--icon button--icon--login")(0).Click
  Application.Wait (Now + TimeSerial(0, 0, 2))
  On Error Resume Next
  For Each DD In Doc.getElementsByTagName("a")
    If DD.className Like "fauxBlockLink-linkRow*" Then
      GetPostGPE = CLng(DD.innerText): Exit Function
    End If
  Next DD
  IE.Quit: Set IE = Nothing: Set DD = IE: Set Doc = IE: Set Obj = IE:
End Function

Miccpro · 17/9/19

HeSanbi đã viết:

PHP:

Sub Test_GetPostGPE()
  Debug.Print GetPostGPE("******", "*******")
End Sub

Function GetPostGPE&(Account$, Pass$)
  Dim Obj As Object, Doc As Object
  Dim IE As Object, DD As Object
  Const Url = "https://www.giaiphapexcel.com/diendan/account/account-details"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Visible = True
  IE.Navigate Url
  Do Until IE.readyState = 4: DoEvents: Loop
  Application.Wait (Now + TimeSerial(0, 0, 1))
  Do Until IE.readyState = 4: DoEvents: Loop
  Set Doc = IE.document
  Set Obj = Doc.getElementsByClassName("p-body-pageContent")(0).getElementsByClassName("input")
  Obj(0).Value = Account
  Obj(1).Value = Pass
  Doc.getElementsByClassName("button button--primary button--icon button--icon--login")(0).Click
  Application.Wait (Now + TimeSerial(0, 0, 2))
  On Error Resume Next
  For Each DD In Doc.getElementsByTagName("a")
    If DD.className Like "fauxBlockLink-linkRow*" Then
      GetPostGPE = CLng(DD.innerText): Exit Function
    End If
  Next DD
  IE.Quit: Set IE = Nothing: Set DD = IE: Set Doc = IE: Set Obj = IE:
End Function

Bác có thể lấy giúp em dữ liệu từ web này khi cho trước trạm khí tượng và thời gian lấy dữ liệu được không ạ?

https://www.accuweather.com/vi/vn/vinh/355417/september-weather/355417?year=2019&view=list

HeSanbi · 17/9/19

Miccpro đã viết:
Bác có thể lấy giúp em dữ liệu từ web này khi cho trước trạm khí tượng và thời gian lấy dữ liệu được không ạ?

https://www.accuweather.com/vi/vn/vinh/355417/september-weather/355417?year=2019&view=list

Bạn tìm kiếm trên GPE

Miccpro · 17/9/19

HeSanbi đã viết:
Bạn tìm kiếm trên GPE

Trước em đã tìm và làm theo file ở link này thì OK ạ
https://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-thời-tiết-accuweather-để-điền-vào-nhật-ký-thi-công.137158/page-2
Giờ nghe bác befaint bảo họ chuyển hết thành Script rồi và em thử chạy thì nó báo lỗi 'run time error 91'
Trong công việc em rất cần lấy dữ liệu thời tiết này, mong bác nghĩ cách giúp. Em xin cảm ơn

HeSanbi · 18/9/19

Miccpro đã viết:
Trước em đã tìm và làm theo file ở link này thì OK ạ
https://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-thời-tiết-accuweather-để-điền-vào-nhật-ký-thi-công.137158/page-2
Giờ nghe bác befaint bảo họ chuyển hết thành Script rồi và em thử chạy thì nó báo lỗi 'run time error 91'
Trong công việc em rất cần lấy dữ liệu thời tiết này, mong bác nghĩ cách giúp. Em xin cảm ơn

Nếu có thời gian, tôi sẽ xem qua.

phananhvusv · 19/9/19

HeSanbi đã viết:

PHP:

Sub Test_GetPostGPE()
  Debug.Print GetPostGPE("******", "*******")
End Sub

Function GetPostGPE&(Account$, Pass$)
  Dim Obj As Object, Doc As Object
  Dim IE As Object, DD As Object
  Const Url = "https://www.giaiphapexcel.com/diendan/account/account-details"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Visible = True
  IE.Navigate Url
  Do Until IE.readyState = 4: DoEvents: Loop
  Application.Wait (Now + TimeSerial(0, 0, 1))
  Do Until IE.readyState = 4: DoEvents: Loop
  Set Doc = IE.document
  Set Obj = Doc.getElementsByClassName("p-body-pageContent")(0).getElementsByClassName("input")
  Obj(0).Value = Account
  Obj(1).Value = Pass
  Doc.getElementsByClassName("button button--primary button--icon button--icon--login")(0).Click
  Application.Wait (Now + TimeSerial(0, 0, 2))
  On Error Resume Next
  For Each DD In Doc.getElementsByTagName("a")
    If DD.className Like "fauxBlockLink-linkRow*" Then
      GetPostGPE = CLng(DD.innerText): Exit Function
    End If
  Next DD
  IE.Quit: Set IE = Nothing: Set DD = IE: Set Doc = IE: Set Obj = IE:
End Function

Sao nó lại ra số 0 vậy anh?

HeSanbi · 19/9/19

phananhvusv đã viết:
Sao nó lại ra số 0 vậy anh?

Bạn sửa lại Code, tôi chỉ code tạm để bạn sử dụng, không phải code chuyên sâu.
------------------

PHP:

Sub Test_GetPostsGPE()
  Debug.Print GetPostsGPE("*******", "******")
End Sub

Function GetPostsGPE&(Account$, Pass$)
  On Error Resume Next
  Dim Obj As Object
  Dim IE As Object, DD, T$
  Const Url = "https://www.giaiphapexcel.com/diendan/account"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Silent = True
  IE.Visible = False
  IE.Navigate Url
  Do Until IE.readyState = 4: DoEvents: Loop
  Application.Wait (Now + TimeSerial(0, 0, 1))
  Do Until IE.readyState = 4: DoEvents: Loop
  Set Obj = IE.document.all.login
  If Not Obj Is Nothing Then
    IE.document.all.login.Value = Account
    IE.document.all.Password.Value = Pass
    IE.document.forms(1).submit
    Application.Wait (Now + TimeSerial(0, 0, 2))
  End If
  IE.document.getElementsByClassName("avatar avatar--xxs")(0).Click
  Application.Wait (Now + TimeSerial(0, 0, 1))
  For Each DD In IE.document.getElementsByTagName("a")
    T = LCase$(DD.className)
    If T Like LCase$("fauxBlockLink-linkRow*") Then
      GetPostsGPE = CLng(DD.innerText): GoTo Ends
    End If
  Next DD
Ends:
  IE.Close: Set IE = Nothing: Set DD = IE: Set Obj = IE
End Function

quick87 · 18/10/19

HeSanbi đã viết:

Bạn sửa lại Code, tôi chỉ code tạm để bạn sử dụng, không phải code chuyên sâu.
------------------

PHP:

Sub Test_GetPostsGPE()
  Debug.Print GetPostsGPE("*******", "******")
End Sub

Function GetPostsGPE&(Account$, Pass$)
  On Error Resume Next
  Dim Obj As Object
  Dim IE As Object, DD, T$
  Const Url = "https://www.giaiphapexcel.com/diendan/account"
  Set IE = CreateObject("InternetExplorer.Application")
  IE.Silent = True
  IE.Visible = False
  IE.Navigate Url
  Do Until IE.readyState = 4: DoEvents: Loop
  Application.Wait (Now + TimeSerial(0, 0, 1))
  Do Until IE.readyState = 4: DoEvents: Loop
  Set Obj = IE.document.all.login
  If Not Obj Is Nothing Then
    IE.document.all.login.Value = Account
    IE.document.all.Password.Value = Pass
    IE.document.forms(1).submit
    Application.Wait (Now + TimeSerial(0, 0, 2))
  End If
  IE.document.getElementsByClassName("avatar avatar--xxs")(0).Click
  Application.Wait (Now + TimeSerial(0, 0, 1))
  For Each DD In IE.document.getElementsByTagName("a")
    T = LCase$(DD.className)
    If T Like LCase$("fauxBlockLink-linkRow*") Then
      GetPostsGPE = CLng(DD.innerText): GoTo Ends
    End If
  Next DD
Ends:
  IE.Close: Set IE = Nothing: Set DD = IE: Set Obj = IE
End Function

Nhờ bạn @HeSanbi viết giúp thêm đoạn code lấy danh sách bài viết của GPE của 1 thành viên bất kỳ, Cảm ơn bạn nhiều !

Sửa macro get data from web

huybo

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Miccpro

Thành viên thường trực

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Miccpro

Thành viên thường trực

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

phananhvusv

Thành viên chính thức

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

quick87

(/ội...

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian