Web-Scraper-for-Excel/ClipTextModule.bas at main · rmz80/Web-Scraper-for-Excel · 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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Attribute VB_Name = "ClipTextModule"

' >([\t\f\v\?\/\[\]\(\)\' !"£$%&*-:=+@~;#?{}\w]+)<

Option Explicit

Option Compare Text

Option Base 0


Public G_My8Data As String
Public G_My16Data As String

Public G_MyText As String
Public G_URL As String
Public G_V2 As Boolean


Function ClipText(Optional NoShow = 1) As Boolean 'rmm14

  Dim t_html As String
  Dim pos1, pos2, tbody1, tbody2, buf, tpos, tpos2

  ClipText = False

  On Error GoTo ErrHand

 '****************************** GET CLIPBOARD ************************************


  If IsClipboardEmpty = True Then

    MsgBox "The clipboard is empty."
    Exit Function
  End If

  '*********************************
  t_html = GetClipData  'THE BIG ONE
  '*********************************


  If Len(t_html) = 0 Then
    MsgBox "The clipboard does not have any HTML data."
    Exit Function
  End If


  '******************************END OF GET CLIPBOARD *****************************


  '*******SAVE RAW RESULTS AND DITCH SOME SPARE CLIPBOARD INFO ******************

  'tidy up
  pos1 = InStr(t_html, "<!--StartFragment-->")
  pos1 = pos1 + 20
  pos2 = InStr(t_html, "<!--EndFragment-->")
  tbody1 = Mid(t_html, pos1, pos2 - pos1)
  tbody2 = tbody1

  tbody2 = Replace(tbody2, vbCr & vbLf, "")
  tbody2 = Replace(tbody2, vbLf, "")
  t_html = Replace(t_html, tbody1, tbody2)


  'Open G_fpathraw For Output As #1
  'Print #1, t_html
  'Close #1


  'On Error GoTo ErrHand


  G_URL = "??"
  On Error Resume Next

  buf = "SourceURL:"
  tpos = InStr(t_html, buf)
  tpos = tpos + Len(buf)

  tpos2 = InStr(t_html, "<html>")

  G_URL = Mid(t_html, tpos, tpos2 - tpos - 2)


  '**************************************
  'SuperM_Array  'load Supermarket Array

  'G_SuperTag = "<H"  'set a default
  'G_SuperMarket = NONE

  'For a = 0 To 14
  '  If InStr(G_URL, G_SuperM_Data(a, 0)) > 0 Then
  '    G_SuperMarket = a
  '    G_SuperTag = "<" & G_SuperM_Data(a, 1)
  '    Exit For
  '  End If
  'Next

  '**************************************


  '**************************************************************************

  G_My8Data = TidyHTML3(t_html)

  Open G_fpathLine For Output As #1
  Print #1, G_My8Data
  Close #1                'rmm14


  '***************************
  buf = "<body>"
  tpos = InStr(t_html, buf)


  t_html = Mid(t_html, tpos)

  '*************************


  'Open G_fpathHTML For Output As #1
  'Print #1, t_html
  'Close #1


  'Dim IE As Object
  ''***************************************************
  'Set IE = CreateObject("InternetExplorer.Application")
  'IE.Visible = False
  'IE.navigate "about:blank"
  'Do While IE.readyState <> 4
  '  DoEvents
  'Loop
  '***************************************************

  'Set htmlDoc = IE.document

  'htmlDoc.body.innerHTML = t_html

  'G_My16Data = htmlDoc.body.innerHTML  'Using THIS AS DATA

  ClipText = True

Exit Function


ErrHand:

  MsgBox "An error occured in ClipTEXT  " & Err.Number
  Stop


End Function