Hi,
I wonder if some very kind person could help me here, i require a very slight change to some code that James Lankford very kindly provided me with
Currently applies a web query and extract data from that web query and prints it starting from column E
This is fine, but i would like the player ID start in Column E, the Name to be in column G and value in column L?
Is this an easy fix?
The code is listed below
Please, please could some kind person solve my problem
Thanks in advance
I wonder if some very kind person could help me here, i require a very slight change to some code that James Lankford very kindly provided me with
Currently applies a web query and extract data from that web query and prints it starting from column E
This is fine, but i would like the player ID start in Column E, the Name to be in column G and value in column L?
Is this an easy fix?
The code is listed below
Please, please could some kind person solve my problem
Thanks in advance
Code:
Option Explicit
'************************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'************************************************
Sub StartHere()
Dim playerIDIndex As Long
For playerIDIndex = 1 To 999
'''''''''''''''''''''''''''''
' some web pages aren't happy when you make a lot of requests really fast
' so we're going to use the MS Windows standard Sleep function to wait 1/2 second between each call
' this function is supplied by the normal default install of MS Windows
' it is not an excel function
' so the declare statement at the top let's excel know where to find it - kernel32
'''''''''''''''''''''''''''''
Sleep 500
DisplayPlayerInfo _
playerIDIndex, _
ThisWorkbook.Worksheets("Sheet2").Range("E" & CStr(playerIDIndex))
Next
End Sub
'************************************************
Sub DisplayPlayerInfo(playerID As Variant, location As Range)
Dim v As Variant
v = GetPlayerInfo(playerID)
location.Resize(1, UBound(v)).Value = v
End Sub
'************************************************
Function GetPlayerInfo(playerID As Variant) As Variant
Dim first As Long, last As Long
Dim s As String
Dim player_data(1 To 4) As String
Dim wrksht As Excel.Worksheet
Dim q As Excel.QueryTable
Set wrksht = ThisWorkbook.Worksheets.Add
'''''''''''''''''''''''''''''
' set player id
'''''''''''''''''''''''''''''
player_data(1) = CStr(playerID)
s = ""
With wrksht
Set q = .QueryTables.Add _
( _
Connection:="URL;http://www.dreamteamfc.com/fantasyfootball/1011/ViewPlayerProfile.aspx?pid=" & playerID _
, Destination:=wrksht.Range("$A$1") _
)
With q
.Name = "ViewPlayerProfile.aspx?pid=" & playerID
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
'''''''''''''''''''''''''''''''''''''''''''''''''
.SaveData = False ' changed this, don't know if it mkaes a difference
'''''''''''''''''''''''''''''''''''''''''''''''''
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
'''''''''''''''''''''''''''''''''''''''''''''''''
' added some error handling in case the web page isn't found
'''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
.Refresh BackgroundQuery:=False
If Err.Number = 0 Then
'''''''''''''''''''''''''''''''''''''''''''''''''
' the web page and player ID was found
' the values we want should be on line 5
'''''''''''''''''''''''''''''''''''''''''''''''''
s = Trim(wrksht.Cells(5, 1).Value)
If Len(s) > 0 Then
'''''''''''''''''''''''''''''
' get player name
'''''''''''''''''''''''''''''
first = InStr(s, "Name: ")
last = InStr(s, "Club:")
If first > 0 And last > 0 Then
player_data(2) = Mid(s, first + 6, last - first - 7)
End If
'''''''''''''''''''''''''''''
' get player club
'''''''''''''''''''''''''''''
first = InStr(s, "Club: ")
last = InStr(s, "Value:")
If first > 0 And last > 0 Then
player_data(3) = Mid(s, first + 6, last - first - 7)
End If
'''''''''''''''''''''''''''''
' get player value
'''''''''''''''''''''''''''''
first = InStr(s, "Value: ")
If first > 0 Then
player_data(4) = Mid(s, first + 8)
End If
End If
Else
'''''''''''''''''''''''''''''''''''''''''''''''''
' Err.Number <> 0
' the web page and player ID was NOT found
' we don't really do anything
' just print the error message in DEBUG window
' the function will continue on and return the player_data array which will contain blank strings
'''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print "Player ID: " & playerID & vbCrLf & Err.Description & vbCrLf & "Error Number: " & Err.Number
End If
'''''''''''''''''''''''''''''
' turn off the ability to check for errors
' let excel vba handle them
' any errors now will pop up in the standeard excel window
'''''''''''''''''''''''''''''
On Error GoTo 0
'''''''''''''''''''''''''''''''''''''''''''''''''
End With
q.Delete
Set q = Nothing
End With
wrksht.Cells.Clear
Application.DisplayAlerts = False
wrksht.Delete
Application.DisplayAlerts = True
Set wrksht = Nothing
GetPlayerInfo = player_data
End Function
'************************************************
