WebScrap4Cal/vbaCode at main · Jpurz/WebScrap4Cal · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Sub CalendarUpdate()

Call filterArtist

Call GetDates

End Sub

Sub filterArtist()

Dim objIE As InternetExplorer
Dim ele As Object
Dim y As Integer
Dim x As Integer
Dim fixedDate As String

 Set objIE = New InternetExplorer
 objIE.Visible = False

 url = "https://....."

 objIE.Navigate url

  Do While objIE.ReadyState <> 4: DoEvents:
  Loop

x = 2

For Each ele In objIE.Document.getElementsByClassName("content")
strContent = Replace(ele.textContent, Chr(10), "")
strLeft = Left(LTrim(strContent), 30)

  Sheets("CalendarUpdate").Range("A" & x).Value = strLeft
  x = x + 1

Next

objIE.Quit

End Sub

Sub GetDates()

'Dim stringOne As String
'Dim regexOne As Object
'Dim regexOneDay As Object
'Dim theMatches As Object
'Dim Match As Object
Dim objIE As InternetExplorer
Dim ele As Object
Dim y As Integer
Dim x As Integer
Dim fixedDate As String

 Set objIE = New InternetExplorer
 objIE.Visible = False

 url = "https://..."

 objIE.Navigate url

  Do While objIE.ReadyState <> 4: DoEvents:
  Loop

Set regexOne = New RegExp
Set regexOneDay = New RegExp
Set regexOneYear = New RegExp

regexOne.pattern = "([A-Z][a-z]{2,})"   'gets the month
regexOneDay.pattern = "(0[1-9]|[12][0-9]|3[01])"   'gets the day
regexOneYear.pattern = "(\d{4})"     'gets the year

regexOne.Global = True
regexOneDay.Global = False
regexOneYear.Global = True

y = 2

For Each ele In objIE.Document.getElementsByClassName("event-card-content")

strContent = Replace(ele.textContent, Chr(10), "")
strDate = Mid(strContent, 125, 70)
fixedDate = Replace(strDate, " ", "")

    Set theMatches = regexOne.Execute(fixedDate)
    For Each Match In theMatches
      Monthx = Match.Value
      'MsgBox x
    Next

    Set theMatches = regexOneDay.Execute(fixedDate)
    For Each Match In theMatches
      Dayx = Match.Value
      'MsgBox x
    Next


    Set theMatches = regexOneYear.Execute(fixedDate)
    For Each Match In theMatches
      YearX = Match.Value
      'MsgBox x
    Next

  parsedDate = Monthx & " " & Dayx & ", " & YearX

  Sheets("CalendarUpdate").Range("AA" & y).Value = parsedDate
  y = y + 1
Next

'MsgBox parsedDate

objIE.Quit
End Sub