質問するログイン新規登録

回答編集履歴

1

追加

2020/03/14 11:51

投稿

Reach
Reach

スコア735

answer CHANGED
@@ -1,6 +1,15 @@
1
1
  Selenium なのか等 よく分かりませんが
2
2
 
3
3
  ```VBA
4
+ #If VBA7 Then
5
+ Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
6
+ #Else
7
+ Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
8
+ #End If
9
+
10
+
11
+
12
+
4
13
  Sub test()
5
14
 
6
15
 
@@ -10,7 +19,7 @@
10
19
 
11
20
  For Each anchor In Driver.FindElementsByTag("a").Attribute("href")
12
21
 
13
- 'Debug.Print anchor
22
+
14
23
  '検索したURLに特定文字が入っていた場合のみSheet2に蓄積
15
24
  If anchor Like "*/kensaku/*" Then
16
25
 
@@ -24,6 +33,48 @@
24
33
  Next
25
34
 
26
35
  End Sub
36
+
37
+ Sub test_2()
38
+
39
+ Dim objIE
40
+ Dim anchor As HTMLAnchorElement
41
+
42
+
43
+ Set objIE = CreateObject("InternetExplorer.Application")
44
+ objIE.Visible = True
45
+ objIE.navigate "検索対象URL"
46
+
47
+ Do While objIE.Busy = True Or objIE.readyState <> 4
48
+ DoEvents
49
+ Sleep 1
50
+ Loop
51
+
52
+ Do While objIE.document.readyState <> "complete"
53
+ DoEvents
54
+ Sleep 1
55
+ Loop
56
+
57
+ For Each anchor In objIE.document.Links
58
+
59
+
60
+
61
+ '検索したURLに特定文字が入っていた場合のみSheet2に蓄積
62
+ If anchor.href Like "*/kensaku/*" Then
63
+
64
+ Debug.Print anchor.href
65
+ ' ws1.Range("AE4").Value = anchor.href
66
+ ' Last_Row = ws1.Cells(Rows.Count, 31).End(xlUp).Row
67
+ ' Last_Row = Last_Row + 1
68
+
69
+ End If
70
+
71
+ Next
72
+
73
+ objIE.Quit
74
+ Set objIE = Nothing
75
+
76
+
77
+ End Sub
27
78
  ```
28
79
 
29
80
  あと 参照設定を忘れずに 行って下さい