commit 245fac3efc496202e0f71a40e21dda4841fed09d Author: alexei.dolgolyov Date: Sat Feb 28 22:09:46 2026 +0300 Add Marathon Bet live stats VBA scraper - MarathonStats.bas: VBA module that fetches live sports data from marathonbet.by using curl (handles gzip compression), parses HTML for team names, scores, odds, and outputs to formatted Excel sheet - RunMarathon.ps1: PowerShell launcher to automate Excel macro execution - MarathonStats.xlsm: Pre-built workbook with sample output Co-Authored-By: Claude Opus 4.6 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..dff7cd7 --- /dev/null +++ b/.gitignore @@ -0,0 +1,15 @@ +# Temp/helper scripts +FindOffice.ps1 +QuickTest.ps1 +TestConnections.ps1 +FetchPage.ps1 +DiagnoseHTTP.ps1 +CheckOutput.ps1 +VerifyData.ps1 +RunAndVerify.ps1 + +# Page dumps +page_dump.html + +# Excel temp files +~$*.xls* diff --git a/MarathonStats.bas b/MarathonStats.bas new file mode 100644 index 0000000..ed327e4 --- /dev/null +++ b/MarathonStats.bas @@ -0,0 +1,662 @@ +Attribute VB_Name = "MarathonStats" +'========================================================================== +' MarathonStats Module +' +' Fetches live sports statistics from Marathon Bet (BY) and outputs +' results to a well-formatted Excel worksheet. +' +' URL: https://www.marathonbet.by/su/live/45356 +' Usage: Run macro "FetchMarathonStats" from Excel (Alt+F8) +' +' Fetch method: curl.exe (handles gzip and bypasses server restrictions) +' Parse method: InStr-based HTML parsing targeting Marathon's DOM markers +'========================================================================== +Option Explicit + +' --------------------------------------------------------------------------- +' Configuration +' --------------------------------------------------------------------------- +Private Const PAGE_URL As String = "https://www.marathonbet.by/su/live/45356" +Private Const WS_NAME As String = "LiveStats" +Private Const DATA_START_ROW As Long = 6 +Private Const NUM_COLS As Long = 8 + +' --------------------------------------------------------------------------- +' Color palette (Long = BGR) +' --------------------------------------------------------------------------- +Private Const CLR_TITLE_BG As Long = 7360544 ' dark teal +Private Const CLR_HDR_BG As Long = 10053171 ' medium blue-gray +Private Const CLR_SPORT_BG As Long = 14994616 ' light steel blue +Private Const CLR_ALT_ROW As Long = 15790320 ' very light gray +Private Const CLR_WHITE As Long = 16777215 +Private Const CLR_BORDER As Long = 12566463 ' medium gray + +' --------------------------------------------------------------------------- +' Event data structure +' --------------------------------------------------------------------------- +Private Type TEvent + League As String + Team1 As String + Team2 As String + Score As String + MatchTime As String + Odds1 As String + Odds2 As String +End Type + +Private m_Events() As TEvent +Private m_Count As Long +Private m_Sport As String + +' =========================================================================== +' PUBLIC: Main entry point +' =========================================================================== +Public Sub FetchMarathonStats() + On Error GoTo Fail + + Application.ScreenUpdating = False + Application.Cursor = xlWait + m_Count = 0 + m_Sport = "" + + Dim ws As Worksheet + Set ws = SetupSheet() + + ' --- Fetch HTML via curl --- + Application.StatusBar = "Fetching page with curl..." + Dim html As String + html = FetchWithCurl() + + If Len(html) < 200 Then + ws.Range("A" & DATA_START_ROW).Value = _ + "Failed to fetch page. Ensure curl.exe is available and internet is connected." + ws.Range("A" & DATA_START_ROW).Font.Italic = True + Application.StatusBar = False + MsgBox "Could not retrieve page content." & vbCrLf & _ + "Verify curl.exe is in PATH and network is available.", _ + vbCritical, "Fetch Error" + GoTo Done + End If + + ' --- Parse HTML --- + Application.StatusBar = "Parsing events..." + ParseHTML html + + ' --- Write results --- + If m_Count > 0 Then + Application.StatusBar = "Formatting output..." + WriteStructuredData ws + FormatDataSheet ws + ws.Activate: ws.Range("A1").Select + Application.StatusBar = False + MsgBox m_Count & " events loaded." & vbCrLf & _ + "(" & m_Count & " " & ChrW(1089) & ChrW(1086) & ChrW(1073) & _ + ChrW(1099) & ChrW(1090) & ChrW(1080) & ChrW(1081) & ")", _ + vbInformation, "Marathon Stats" + Else + WriteTitle ws + ws.Range("A" & DATA_START_ROW).Value = _ + "No live events found on page. Try again when live games are active." + ws.Range("A" & DATA_START_ROW).Font.Italic = True + Application.StatusBar = False + MsgBox "No live events found.", vbExclamation, "Marathon Stats" + End If + + GoTo Done + +Fail: + MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, "Error" +Done: + On Error Resume Next + Application.Cursor = xlDefault + Application.StatusBar = False + Application.ScreenUpdating = True +End Sub + +' =========================================================================== +' FETCH: Use curl.exe to download page HTML +' =========================================================================== +Private Function FetchWithCurl() As String + On Error GoTo CurlFail + + Dim tempFile As String + tempFile = Environ("TEMP") & "\marathon_live_page.html" + + ' Build curl command with browser-like headers + Dim cmd As String + cmd = "cmd /c curl.exe -s -L -k --compressed --max-time 20 " & _ + "-H ""User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) " & _ + "AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"" " & _ + "-H ""Accept-Language: ru-RU,ru;q=0.9"" " & _ + "-H ""Accept: text/html,application/xhtml+xml"" " & _ + """" & PAGE_URL & """ > """ & tempFile & """" + + ' Execute synchronously + Dim wsh As Object + Set wsh = CreateObject("WScript.Shell") + wsh.Run cmd, 0, True ' 0=hidden, True=wait + + ' Verify file exists and has content + Dim fso As Object + Set fso = CreateObject("Scripting.FileSystemObject") + If Not fso.FileExists(tempFile) Then GoTo CurlFail + If fso.GetFile(tempFile).Size < 100 Then GoTo CurlFail + + ' Read file as UTF-8 (for Russian text) + Dim stream As Object + Set stream = CreateObject("ADODB.Stream") + With stream + .Type = 2 ' text + .Charset = "UTF-8" + .Open + .LoadFromFile tempFile + FetchWithCurl = .ReadText + .Close + End With + + ' Clean up temp file + On Error Resume Next + fso.DeleteFile tempFile + On Error GoTo 0 + Exit Function + +CurlFail: + FetchWithCurl = "" +End Function + +' =========================================================================== +' PARSE: Extract events from Marathon HTML +' =========================================================================== +Private Sub ParseHTML(html As String) + ' Detect sport type from data-sport-type attribute + m_Sport = DetectSport(html) + + ' Sequential scan through HTML for known markers + Dim pos As Long + Dim curLeague As String + Dim curScore As String + Dim curTime As String + + pos = 1 + curLeague = "" + curScore = "" + curTime = "" + + Do + ' Find the next occurrence of each marker + Dim posLabel As Long: posLabel = InStr(pos, html, "category-label simple-live") + Dim posScore As Long: posScore = InStr(pos, html, "cl-left red") + Dim posTeam As Long: posTeam = InStr(pos, html, "data-member-link=""true"">") + + ' Nothing left to find + If posLabel = 0 And posScore = 0 And posTeam = 0 Then Exit Do + + ' Find the minimum positive position + Dim minPos As Long: minPos = 2147483647 + If posLabel > 0 And posLabel < minPos Then minPos = posLabel + If posScore > 0 And posScore < minPos Then minPos = posScore + If posTeam > 0 And posTeam < minPos Then minPos = posTeam + + ' --- Category label (league name) --- + If minPos = posLabel And posLabel > 0 Then + curLeague = ExtractLeague(html, posLabel) + pos = posLabel + 30 + + ' --- Score line --- + ElseIf minPos = posScore And posScore > 0 Then + curScore = ExtractScore(html, posScore) + curTime = ExtractGameTime(html, posScore) + pos = posScore + 20 + + ' --- Team name (first of pair) --- + ElseIf minPos = posTeam And posTeam > 0 Then + Dim team1 As String + team1 = ExtractTeamName(html, posTeam) + pos = posTeam + 30 + + ' Find the second team + Dim posTeam2 As Long + posTeam2 = InStr(pos, html, "data-member-link=""true"">") + If posTeam2 = 0 Then Exit Do + + Dim team2 As String + team2 = ExtractTeamName(html, posTeam2) + pos = posTeam2 + 30 + + ' Find odds (first 2 data-selection-price after team2, before next event) + Dim odds1 As String, odds2 As String + ExtractOddsPair html, pos, odds1, odds2 + + ' Store event + AddEvent curLeague, team1, team2, curScore, curTime, odds1, odds2 + curScore = "" + curTime = "" + End If + Loop +End Sub + +' =========================================================================== +' EXTRACT HELPERS +' =========================================================================== + +' --- Sport type from data-sport-type="..." --- +Private Function DetectSport(html As String) As String + Dim marker As String: marker = "data-sport-type=""" + Dim p As Long: p = InStr(1, html, marker) + If p = 0 Then + DetectSport = "Basketball" + Exit Function + End If + p = p + Len(marker) + Dim q As Long: q = InStr(p, html, """") + If q > p Then + Dim raw As String: raw = Mid(html, p, q - p) + ' Translate to Russian + Select Case LCase(raw) + Case "basketball": DetectSport = ChrW(1041) & ChrW(1072) & ChrW(1089) & ChrW(1082) & ChrW(1077) & ChrW(1090) & ChrW(1073) & ChrW(1086) & ChrW(1083) + Case "football", "soccer": DetectSport = ChrW(1060) & ChrW(1091) & ChrW(1090) & ChrW(1073) & ChrW(1086) & ChrW(1083) + Case "icehockey": DetectSport = ChrW(1061) & ChrW(1086) & ChrW(1082) & ChrW(1082) & ChrW(1077) & ChrW(1081) + Case "tennis": DetectSport = ChrW(1058) & ChrW(1077) & ChrW(1085) & ChrW(1085) & ChrW(1080) & ChrW(1089) + Case Else: DetectSport = raw + End Select + Else + DetectSport = "Basketball" + End If +End Function + +' --- League name from

...

--- +Private Function ExtractLeague(html As String, startPos As Long) As String + ' Find the > that opens the h2 tag content + Dim p As Long: p = InStr(startPos, html, ">") + If p = 0 Then Exit Function + p = p + 1 + + ' Find + Dim q As Long: q = InStr(p, html, "") + If q = 0 Or q - p > 500 Then Exit Function + + Dim raw As String: raw = Mid(html, p, q - p) + ExtractLeague = StripTags(raw) +End Function + +' --- Score from
content --- +Private Function ExtractScore(html As String, startPos As Long) As String + ' Find the > that opens the div + Dim p As Long: p = InStr(startPos, html, ">") + If p = 0 Then Exit Function + p = p + 1 + + ' Take content up to time-description marker or
+ ' Use just "time-description" for flexible matching + Dim q1 As Long: q1 = InStr(p, html, "time-description") + Dim q2 As Long: q2 = InStr(p, html, "") + Dim q As Long + If q1 > 0 And (q2 = 0 Or q1 < q2) Then + ' Back up to the opening < of the span tag + Dim backTrack As Long: backTrack = q1 + Do While backTrack > p And Mid(html, backTrack, 1) <> "<" + backTrack = backTrack - 1 + Loop + If backTrack > p Then q = backTrack Else q = q1 + Else + q = q2 + End If + If q = 0 Or q <= p Or q - p > 300 Then Exit Function + + Dim raw As String: raw = Mid(html, p, q - p) + ExtractScore = CleanText(StripTags(raw)) +End Function + +' --- Game time from
near the score --- +Private Function ExtractGameTime(html As String, scorePos As Long) As String + ' Look for "green bold nobr" within 300 chars after score position + Dim marker As String: marker = "green bold nobr" + Dim p As Long: p = InStr(scorePos, html, marker) + If p = 0 Or p - scorePos > 300 Then Exit Function + + ' Find the > to get content + p = InStr(p, html, ">") + If p = 0 Then Exit Function + p = p + 1 + + ' Find
+ Dim q As Long: q = InStr(p, html, "") + If q = 0 Or q - p > 50 Then Exit Function + + ExtractGameTime = CleanText(StripTags(Mid(html, p, q - p))) +End Function + +' --- Team name from TeamName --- +Private Function ExtractTeamName(html As String, startPos As Long) As String + Dim marker As String: marker = "data-member-link=""true"">" + Dim p As Long: p = InStr(startPos, html, marker) + If p = 0 Then Exit Function + p = p + Len(marker) + + Dim q As Long: q = InStr(p, html, "") + If q = 0 Or q - p > 100 Then Exit Function + + ExtractTeamName = Trim(Mid(html, p, q - p)) +End Function + +' --- Extract first 2 odds after position, bounded by next event/category --- +Private Sub ExtractOddsPair(html As String, afterPos As Long, _ + ByRef odds1 As String, ByRef odds2 As String) + odds1 = "" + odds2 = "" + + ' Determine boundary: next team marker or next category + Dim boundary As Long: boundary = Len(html) + Dim b1 As Long: b1 = InStr(afterPos, html, "data-member-link=""true"">") + Dim b2 As Long: b2 = InStr(afterPos, html, "category-label simple-live") + If b1 > 0 And b1 < boundary Then boundary = b1 + If b2 > 0 And b2 < boundary Then boundary = b2 + + ' Find first odds + Dim marker As String: marker = "data-selection-price=""" + Dim p1 As Long: p1 = InStr(afterPos, html, marker) + If p1 = 0 Or p1 > boundary Then Exit Sub + + odds1 = ExtractOddsAt(html, p1) + + ' Find second odds + Dim p2 As Long: p2 = InStr(p1 + 20, html, marker) + If p2 = 0 Or p2 > boundary Then Exit Sub + + odds2 = ExtractOddsAt(html, p2) +End Sub + +' --- Extract single odds value from data-selection-price="X" --- +Private Function ExtractOddsAt(html As String, startPos As Long) As String + Dim marker As String: marker = "data-selection-price=""" + Dim p As Long: p = InStr(startPos, html, marker) + If p = 0 Then Exit Function + p = p + Len(marker) + + Dim q As Long: q = InStr(p, html, """") + If q = 0 Or q - p > 15 Then Exit Function + + ExtractOddsAt = Mid(html, p, q - p) +End Function + +' --- Strip HTML tags and control characters from a string --- +Private Function StripTags(s As String) As String + Dim result As String + Dim inTag As Boolean + Dim i As Long + Dim ch As String + Dim code As Long + + For i = 1 To Len(s) + ch = Mid(s, i, 1) + code = AscW(ch) + If ch = "<" Then + inTag = True + ElseIf ch = ">" Then + inTag = False + ElseIf Not inTag Then + ' Replace newlines/tabs/control chars with space + If code = 10 Or code = 13 Or code = 9 Then + result = result & " " + Else + result = result & ch + End If + End If + Next i + + ' Collapse multiple spaces + Do While InStr(result, " ") > 0 + result = Replace(result, " ", " ") + Loop + + StripTags = Trim(result) +End Function + +' --- Clean text: strip newlines, tabs, collapse whitespace --- +Private Function CleanText(s As String) As String + Dim r As String: r = s + r = Replace(r, vbCrLf, " ") + r = Replace(r, vbCr, " ") + r = Replace(r, vbLf, " ") + r = Replace(r, vbTab, " ") + ' Collapse multiple spaces + Do While InStr(r, " ") > 0 + r = Replace(r, " ", " ") + Loop + CleanText = Trim(r) +End Function + +' =========================================================================== +' EVENT STORAGE +' =========================================================================== +Private Sub AddEvent(League As String, Team1 As String, Team2 As String, _ + Score As String, MatchTime As String, _ + Odds1 As String, Odds2 As String) + ' Skip entries with empty teams + If Len(Trim(Team1)) = 0 Or Len(Trim(Team2)) = 0 Then Exit Sub + + m_Count = m_Count + 1 + ReDim Preserve m_Events(1 To m_Count) + + With m_Events(m_Count) + .League = Trim(League) + .Team1 = Trim(Team1) + .Team2 = Trim(Team2) + .Score = Trim(Score) + .MatchTime = Trim(MatchTime) + .Odds1 = Trim(Odds1) + .Odds2 = Trim(Odds2) + End With +End Sub + +' =========================================================================== +' WORKSHEET SETUP +' =========================================================================== +Private Function SetupSheet() As Worksheet + Dim ws As Worksheet + On Error Resume Next + Set ws = ThisWorkbook.Worksheets(WS_NAME) + On Error GoTo 0 + + If ws Is Nothing Then + Set ws = ThisWorkbook.Worksheets.Add( _ + After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) + ws.Name = WS_NAME + Else + ws.Cells.Clear + ws.Cells.Interior.ColorIndex = xlNone + ws.Cells.Borders.LineStyle = xlNone + ws.Cells.Font.Bold = False + ws.Cells.Font.Italic = False + + ' Reset freeze panes + ws.Activate + ActiveWindow.FreezePanes = False + End If + + Set SetupSheet = ws +End Function + +' =========================================================================== +' WRITE STRUCTURED DATA +' =========================================================================== +Private Sub WriteStructuredData(ws As Worksheet) + ' --- Title --- + WriteTitle ws + + ' --- Column headers (row 5) --- + Dim hdrRow As Long: hdrRow = DATA_START_ROW - 1 + ' #, Liga, Komanda 1, Komanda 2, Schet, Vremya, P1, P2 + ws.Cells(hdrRow, 1).Value = "#" + ws.Cells(hdrRow, 2).Value = ChrW(1051) & ChrW(1080) & ChrW(1075) & ChrW(1072) ' Лига + ws.Cells(hdrRow, 3).Value = ChrW(1050) & ChrW(1086) & ChrW(1084) & ChrW(1072) & _ + ChrW(1085) & ChrW(1076) & ChrW(1072) & " 1" ' Команда 1 + ws.Cells(hdrRow, 4).Value = ChrW(1050) & ChrW(1086) & ChrW(1084) & ChrW(1072) & _ + ChrW(1085) & ChrW(1076) & ChrW(1072) & " 2" ' Команда 2 + ws.Cells(hdrRow, 5).Value = ChrW(1057) & ChrW(1095) & ChrW(1105) & ChrW(1090) ' Счёт + ws.Cells(hdrRow, 6).Value = ChrW(1042) & ChrW(1088) & ChrW(1077) & ChrW(1084) & _ + ChrW(1103) ' Время + ws.Cells(hdrRow, 7).Value = ChrW(1055) & "1" ' П1 + ws.Cells(hdrRow, 8).Value = ChrW(1055) & "2" ' П2 + + ' --- Data rows --- + Dim r As Long + For r = 1 To m_Count + Dim dataRow As Long: dataRow = DATA_START_ROW + r - 1 + With m_Events(r) + ws.Cells(dataRow, 1).Value = r + ws.Cells(dataRow, 2).Value = .League + ws.Cells(dataRow, 3).Value = .Team1 + ws.Cells(dataRow, 4).Value = .Team2 + ws.Cells(dataRow, 5).Value = .Score + ws.Cells(dataRow, 6).Value = .MatchTime + ws.Cells(dataRow, 7).Value = .Odds1 + ws.Cells(dataRow, 8).Value = .Odds2 + End With + Next r +End Sub + +' =========================================================================== +' TITLE SECTION +' =========================================================================== +Private Sub WriteTitle(ws As Worksheet) + ' Row 1: Title with sport name + Dim title As String + If Len(m_Sport) > 0 Then + title = "Marathon Bet " & ChrW(8212) & " " & m_Sport & " Live" + Else + title = "Marathon Bet " & ChrW(8212) & " Live " & _ + ChrW(1057) & ChrW(1090) & ChrW(1072) & ChrW(1090) & _ + ChrW(1080) & ChrW(1089) & ChrW(1090) & ChrW(1080) & _ + ChrW(1082) & ChrW(1072) + End If + ws.Range("A1").Value = title + ws.Range("A1").Font.Size = 16 + ws.Range("A1").Font.Bold = True + ws.Range("A1:H1").Merge + ws.Range("A1").Interior.Color = CLR_TITLE_BG + ws.Range("A1").Font.Color = CLR_WHITE + ws.Range("A1").RowHeight = 30 + ws.Range("A1").VerticalAlignment = xlVAlignCenter + + ' Row 2: URL + ws.Range("A2").Value = PAGE_URL + ws.Range("A2").Font.Size = 9 + ws.Range("A2").Font.Color = &H999999 + ws.Range("A2:H2").Merge + + ' Row 3: Timestamp + ws.Range("A3").Value = ChrW(1044) & ChrW(1072) & ChrW(1090) & ChrW(1072) & _ + ": " & Format(Now, "dd.mm.yyyy hh:nn:ss") + ws.Range("A3").Font.Size = 9 + ws.Range("A3").Font.Italic = True + ws.Range("A3:H3").Merge +End Sub + +' =========================================================================== +' FORMAT DATA SHEET +' =========================================================================== +Private Sub FormatDataSheet(ws As Worksheet) + Dim lastRow As Long: lastRow = DATA_START_ROW + m_Count - 1 + Dim lastCol As Long: lastCol = NUM_COLS + Dim hdrRow As Long: hdrRow = DATA_START_ROW - 1 + + ' --- Header row --- + With ws.Range(ws.Cells(hdrRow, 1), ws.Cells(hdrRow, lastCol)) + .Interior.Color = CLR_HDR_BG + .Font.Color = CLR_WHITE + .Font.Bold = True + .Font.Size = 10 + .HorizontalAlignment = xlHAlignCenter + .VerticalAlignment = xlVAlignCenter + .RowHeight = 24 + End With + + ' --- Data rows --- + Dim r As Long + Dim prevLeague As String + + For r = DATA_START_ROW To lastRow + ' Alternating row colors + If (r - DATA_START_ROW) Mod 2 = 1 Then + ws.Range(ws.Cells(r, 1), ws.Cells(r, lastCol)).Interior.Color = CLR_ALT_ROW + End If + + ' League group shading + Dim cellLeague As String + cellLeague = CStr(ws.Cells(r, 2).Value) + If cellLeague <> prevLeague And Len(cellLeague) > 0 Then + ws.Range(ws.Cells(r, 1), ws.Cells(r, lastCol)).Interior.Color = CLR_SPORT_BG + ws.Cells(r, 2).Font.Bold = True + prevLeague = cellLeague + End If + + ' Row number - centered, gray + ws.Cells(r, 1).HorizontalAlignment = xlHAlignCenter + ws.Cells(r, 1).Font.Color = &H888888 + + ' Score - bold, centered, larger + ws.Cells(r, 5).Font.Bold = True + ws.Cells(r, 5).HorizontalAlignment = xlHAlignCenter + ws.Cells(r, 5).Font.Size = 11 + + ' Time - centered + ws.Cells(r, 6).HorizontalAlignment = xlHAlignCenter + + ' Odds - centered + ws.Cells(r, 7).HorizontalAlignment = xlHAlignCenter + ws.Cells(r, 8).HorizontalAlignment = xlHAlignCenter + Next r + + ' --- Borders --- + With ws.Range(ws.Cells(hdrRow, 1), ws.Cells(lastRow, lastCol)) + .Borders(xlEdgeLeft).LineStyle = xlContinuous + .Borders(xlEdgeLeft).Color = CLR_BORDER + .Borders(xlEdgeRight).LineStyle = xlContinuous + .Borders(xlEdgeRight).Color = CLR_BORDER + .Borders(xlEdgeTop).LineStyle = xlContinuous + .Borders(xlEdgeTop).Color = CLR_BORDER + .Borders(xlEdgeBottom).LineStyle = xlContinuous + .Borders(xlEdgeBottom).Color = CLR_BORDER + .Borders(xlInsideHorizontal).LineStyle = xlContinuous + .Borders(xlInsideHorizontal).Color = CLR_BORDER + .Borders(xlInsideHorizontal).Weight = xlThin + .Borders(xlInsideVertical).LineStyle = xlContinuous + .Borders(xlInsideVertical).Color = CLR_BORDER + .Borders(xlInsideVertical).Weight = xlThin + End With + + ' --- Column widths --- + ws.Columns(1).ColumnWidth = 5 ' # + ws.Columns(2).ColumnWidth = 38 ' League + ws.Columns(3).ColumnWidth = 26 ' Team 1 + ws.Columns(4).ColumnWidth = 26 ' Team 2 + ws.Columns(5).ColumnWidth = 22 ' Score + ws.Columns(6).ColumnWidth = 10 ' Time + ws.Columns(7).ColumnWidth = 9 ' P1 + ws.Columns(8).ColumnWidth = 9 ' P2 + + ' --- Freeze panes --- + ws.Range("A" & DATA_START_ROW).Select + ActiveWindow.FreezePanes = True + + ' --- Print setup --- + On Error Resume Next + With ws.PageSetup + .Orientation = xlLandscape + .FitToPagesWide = 1 + .FitToPagesTall = False + .PrintTitleRows = "$" & hdrRow & ":$" & hdrRow + End With + On Error GoTo 0 + + ' --- Footer --- + Dim footerRow As Long: footerRow = lastRow + 2 + ws.Cells(footerRow, 1).Value = ChrW(1042) & ChrW(1089) & ChrW(1077) & _ + ChrW(1075) & ChrW(1086) & " " & ChrW(1089) & ChrW(1086) & _ + ChrW(1073) & ChrW(1099) & ChrW(1090) & ChrW(1080) & ChrW(1081) & _ + ": " & m_Count + ws.Cells(footerRow, 1).Font.Italic = True + ws.Cells(footerRow, 1).Font.Size = 9 + ws.Cells(footerRow, 1).Font.Color = &H888888 +End Sub diff --git a/MarathonStats.xlsm b/MarathonStats.xlsm new file mode 100644 index 0000000..ca47522 Binary files /dev/null and b/MarathonStats.xlsm differ diff --git a/RunMarathon.ps1 b/RunMarathon.ps1 new file mode 100644 index 0000000..eb6ad2b --- /dev/null +++ b/RunMarathon.ps1 @@ -0,0 +1,47 @@ +$ErrorActionPreference = "Stop" + +$basPath = "c:\Users\Alexei\Documents\VBA\MarathonStats.bas" +$savePath = "c:\Users\Alexei\Documents\VBA\MarathonStats.xlsm" + +Write-Host "=== Marathon Stats Launcher ===" -ForegroundColor Cyan +Write-Host "" + +Write-Host "[1/5] Starting Excel..." -ForegroundColor Yellow +$excel = New-Object -ComObject Excel.Application +$excel.Visible = $true +$excel.DisplayAlerts = $false + +Write-Host "[2/5] Creating workbook..." -ForegroundColor Yellow +$workbook = $excel.Workbooks.Add() + +Write-Host "[3/5] Importing VBA module..." -ForegroundColor Yellow +try { + $null = $workbook.VBProject.VBComponents.Import($basPath) + Write-Host " Module imported OK" -ForegroundColor Green +} catch { + Write-Host "ERROR: Cannot access VBA project - $_" -ForegroundColor Red + $excel.Quit() + [System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null + exit 1 +} + +Write-Host "[4/5] Running FetchMarathonStats..." -ForegroundColor Yellow +Write-Host " (curl will fetch page, then parse and format)" -ForegroundColor Gray +try { + $excel.Run("FetchMarathonStats") + Write-Host " Macro completed" -ForegroundColor Green +} catch { + Write-Host " Macro error: $($_.Exception.Message)" -ForegroundColor Red +} + +Write-Host "[5/5] Saving workbook..." -ForegroundColor Yellow +try { + if (Test-Path $savePath) { Remove-Item $savePath -Force } + $workbook.SaveAs($savePath, 52) + Write-Host " Saved to: $savePath" -ForegroundColor Green +} catch { + Write-Host " Save error: $($_.Exception.Message)" -ForegroundColor Red +} + +Write-Host "" +Write-Host "=== Done! ===" -ForegroundColor Cyan