Hi,
I have an issue with
vb internet control. Am getting an Access Denied error msg even tho I have ticked the reference 'Microsoft Internet Controls'. This reference points to C:\Windows\SysWOW64\ieframe.dll, whereas I think the code I am using needs this to point to shdocvw.dll.
The code I am using is the following, can anyone tell me why this is not working with the above references ticked. And more importantly how should i change the below code to work with the new windows7 64 bit reference:
C:\Windows\SysWOW64\ieframe.dll
thx in advance. Russ
Option Explicit
Private IE As Object
Dim t As Date
Sub StartTimer()
If t <> CDate(0) Then Exit Sub
Call xscores
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=t, Procedure:="xscores", Schedule:=False
t = CDate(0)
Call DisconnectFrom
On Error GoTo 0
End Sub
Private Function NavigateTo(strURL As String)
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate strURL
Do Until (.ReadyState = 4 And Not .Busy): DoEvents: Loop
End With
End Function
Private Function DisconnectFrom()
IE.Quit
Set IE = Nothing
End Function
Sub xscores()
Application.ScreenUpdating = False
Dim strURL As String
Dim ieDoc As Object
Dim AllTables As Object
Dim xTable As Object
Dim myWkSht As Worksheet
Dim TblRow As Object
Dim tblCell As Object
Dim r As Integer
Dim c As Integer
Columns("N:O").NumberFormat = "@"
strURL = "http://xscores.com/LiveScore.do?state=soccer&sport=1"
If t = CDate(0) Then
Call NavigateTo(strURL)
End If
Set ieDoc = IE.Document
Set AllTables = ieDoc.frames(3).Document.frames(1).Document.getEle mentsByTagName("TABLE")
Set xTable = AllTables.Item(0)
Set myWkSht = ThisWorkbook.Sheets("Sheet1")
r = 0
c = 0
For Each TblRow In xTable.Rows
r = r + 1
For Each tblCell In TblRow.Cells
c = c + 1
myWkSht.Cells(r, c) = tblCell.innerText
Next tblCell
c = 0
Next TblRow
r = 0
Dim rng As Range
For Each rng In Range(Sheets(1).Range("A1"), Sheets(1).Range("A65536").End(xlUp))
If rng.Text = "K/O" Then
rng.Offset(0, 3).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
rng.Offset(0, 8).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
rng.Offset(0, 16).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next rng
Columns("U:U").ClearContents
Range("A1").Select
'Call DisconnectFrom
't is set at 1 minute intervals
t = Now() + TimeValue("00:01:00")
Application.OnTime EarliestTime:=t, Procedure:="xscores", Schedule:=True
Application.ScreenUpdating = True
End Sub