Sửa macro get data from web

Liên hệ QC
H

huybo

Thành viên hoạt động
Tham gia
24/4/13
Bài viết
115
Được thích
5
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é.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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 đỡ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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 ạ?
 
Upvote 0
Upvote 0
HeSanbi đã viết:
Bạn tìm kiếm trên GPE
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Nếu có thời gian, tôi sẽ xem qua.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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

225153
 
Upvote 0
phananhvusv đã viết:
Sao nó lại ra số 0 vậy anh?
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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ấp chuột vào đây để mở rộng...
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 !
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Hoangquyenbong
  • Question
Lấy hệ số tương ứng cho mã hàng xuất.
Trả lời
2
Đọc
27
Hoangquyenbong
Hoangquyenbong
H
Tính tổng có điều kiện
2
Trả lời
22
Đọc
407
hoaiantrinh
H
L
[xin nhờ giúp đỡ] hàm trích xuất ra dữ liệu thỏa mã điều kiện và ghi vào một ô
Trả lời
12
Đọc
467
VetMini
V
M
Tính tổng max các ký tự giống nhau liên tiếp
Trả lời
9
Đọc
387
sauoc.90
S
phunguyenkt
  • Question
MN cho em xin phần mềm chuyển đổi số sang chữ với ạ, và ko có chữ chẵn, em cảm ơn
Trả lời
2
Đọc
154
ghouls1
ghouls1
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom