Sửa macro get data from web (2 người xem)

  • Thread starter Thread starter huybo
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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
huybo đã viết:
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é.
Nhấp chuột vào đây để mở rộng...
Bạn thử với .Connection = Range("A1").value
 
Upvote 0
mình vừa sửa connection như ý bạn. và thay 1 link mới và ô a1. nhưng chạy thì báo lỗi appplication defined or object - defined error. quay lại kiểm tra xem ô a1 thì lại thấy trả về đường link cũ
 
Upvote 0
huybo đã viết:
mình vừa sửa connection như ý bạn. và thay 1 link mới và ô a1. nhưng chạy thì báo lỗi appplication defined or object - defined error. quay lại kiểm tra xem ô a1 thì lại thấy trả về đường link cũ
Nhấp chuột vào đây để mở rộng...
Ko hiểu ý bạn,
Mình ko để ý kĩ Bạn sửa thành
.Connection = sheets(1).Range("A1").value
 
Upvote 0
Xoá dòng này:
PHP: 
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"
thay bằng:
PHP: 
Dim link as string
link=Range("A1").value
Và
PHP: 
.Connection = link
 
Upvote 0
Sub Macro2()
'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"
Dim link As String
link = Range("A1").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = link
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
vẫn báo lỗi bác ạ
 
Upvote 0
Sub Macro1()
' Macro1 Macro
Dim link1 As String
link1 = Range("D7").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link2 As String
link2 = Range("D2").Value
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("B246").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link3 As String
link3 = Range("D3").Value
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("B297").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link4 As String
link4 = Range("D").Value
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("B348").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Range("B9").Select
End Sub
E copy thêm 3 đoạn code nữa nhưng chạy macro ko được, e làm máy móc thế này không biết sai chỗ nào. mong 2 bác chỉ giáo thêm ạ
 
Upvote 0
huybo đã viết:
Sub Macro1()
' Macro1 Macro
Dim link1 As String
link1 = Range("D7").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link2 As String
link2 = Range("D2").Value
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("B246").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link3 As String
link3 = Range("D3").Value
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("B297").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link4 As String
link4 = Range("D").Value
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("B348").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Range("B9").Select
End Sub
E copy thêm 3 đoạn code nữa nhưng chạy macro ko được, e làm máy móc thế này không biết sai chỗ nào. mong 2 bác chỉ giáo thêm ạ
Nhấp chuột vào đây để mở rộng...
Bạn phải cho biết nó lỗi ntn và lỗi ở đâu chứ.
Bạn sửa lại chỗ này
link4 = Range("D").Value

thành
link4 = Range("D4").Value
 
Upvote 0
Cám ơn bác. E phát hiện ra lỗi của mình rồi ạ. các cell d2 d3... của e nhầm công thức
 
Upvote 0
Cám ơn bác. E phát hiện ra lỗi của mình rồi ạ. các cell d2 d3... của e nhầm công thức
 
Upvote 0
Sub Macro3()
'
' Macro3 Macro
'


'
Dim link1 As String
link1 = Range("C1").Value
'Range("E1").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/2/0/0/3/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B2").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link2 As String
link2 = Range("C2").Value
'Sheets("Fa").Select
'Range("E2").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/2/2/1/1/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("N2").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link3 As String
link3 = Range("C3").Value
'Sheets("Fa").Select
'Range("E3").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2015/2/6/1/1/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("Z2").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link4 As String
link4 = Range("C4").Value
'Sheets("Fa").Select
'Range("E4").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2014/2/10/0/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("AL2").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link5 As String
link5 = Range("C6").Value
'Sheets("Fa").Select
'Range("E6").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/0/0/1/0/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang5"
Range("AX2").Select
With Selection.QueryTable
.Connection = "URL;" & link5
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link6 As String
link6 = Range("C7").Value
'Sheets("Fa").Select
'Range("E7").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang6"
Range("B55").Select
With Selection.QueryTable
.Connection = "URL;" & link6
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link7 As String
link7 = Range("C8").Value
'Sheets("Fa").Select
'Range("E8").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/CashFlow/2016/2/0/1/1/luu-chuyen-tien-te-gian-tiep-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang7"
Range("Z55").Select
With Selection.QueryTable
.Connection = "URL;" & link7
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Sheets("Fa").Select
End Sub

Lại xin làm phiền Bác quanluu và mọi người, e lại bị lỗi tô màu đỏ, tìm hiểu mãi cách sửa mà chưa đc, giúp e với.
 
Upvote 0
Bác nào có code để get data from web thì chỉ giáo cho e? e mới chỉ làm dựa vào record macro
 
Upvote 0
huybo đã viết:
Sub Macro3()
'

Lại xin làm phiền Bác quanluu và mọi người, e lại bị lỗi tô màu đỏ, tìm hiểu mãi cách sửa mà chưa đc, giúp e với.
Nhấp chuột vào đây để mở rộng...

Bạn thay False thành True nhé, vì nếu để False thì cái thứ 1 chưa chạy xong thì cái thứ 2 đã chạy nên báo lỗi, để true thì nó chạy xong link 1 rùi chạy link 2
Còn code get data từ web thì bạn chịu khó search mạng thui, Mình nghĩ trên mạng có mà đầy.
 
Upvote 0
tks bác, số e đang nhọ, mấy file excel đều bị dính lỗi[h=1]excel found unreadable content[/h]nên chưa vào thử dc, bực quá
 
Upvote 0
e chuyển false thành true r nhưng vẫn báo lỗi ở đó, lúc thì báo lỗi ở dòng With Selection.QueryTable
 
Upvote 0
mình có kiểm tra trong data -> connection thì có 7 connection tương ứng 7 lần get data. kiểm tra tiếp properties -> definition thì có 2 cái bị mất connection string ( chính là đường link web). và mình lỗi code của mình thì chỉ quanh đoạn 2 cái này. các bác sửa giúp e với nhé
 
Upvote 0
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 đỡ.Untitled.png
 
Upvote 0
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.

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

A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show (1 người xem)
Trả lời
2
Đọc
53
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ. (1 người xem)
Trả lời
5
Đọc
125
truc.duong87
T
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên (1 người xem)
    • Cảm ơn
Trả lời
1
Đọc
63
phuongnam366377
phuongnam366377
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL
Trả lời
1
Đọc
62
DeTong
D
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
74
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
252
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
131
eagle12
E
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
436
Đọc
57K
hangiang
H
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
383
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
79
Nam168
Nam168
V
Quản lý xuất nhập vật tư trong kho
Trả lời
14
Đọc
549
LOGANWover
L
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
99
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
300
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
211
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File (1 người xem)
Trả lời
16
Đọc
508
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
812
Zizi One
Zizi One
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom