質問編集履歴

1

ビット数記載 sample2の変更版記載 ポート使用待ち処理記載

2021/05/24 08:28

投稿

hodagiri
hodagiri

スコア21

test CHANGED
File without changes
test CHANGED
@@ -4,7 +4,9 @@
4
4
 
5
5
  たまにStartメソッドを実行するとそのままAccessが固まってしまって何も操作できなくなります。
6
6
 
7
- Sample2ではStartメソッドをコメントアウトして実行してみてもGetメソッド時に同様にためなときは固まってしましまいます。
7
+ Sample2ではStartメソッドをコメントアウトして実行してみてもGetメソッド時に同様にためなときは固まってしまいます。
8
+
9
+ msgboxで表示中のようにクリックしても無反応です。
8
10
 
9
11
 
10
12
 
@@ -34,6 +36,46 @@
34
36
 
35
37
 
36
38
 
39
+ 更にsample2の以下を変更してみたが
40
+
41
+ Set driver = CreateObject("Selenium.ChromeDriver")
42
+
43
+ driver.SetCapability "debuggerAddress", "127.0.0.1:9222"
44
+
45
+ Driver.Start
46
+
47
+ Driver.Get "https://www.yahoo.co.jp/"
48
+
49
+
50
+
51
+ Set driver = CreateObject("Selenium.WebDriver")
52
+
53
+ driver.SetCapability "debuggerAddress", "127.0.0.1:9222"
54
+
55
+ Driver.Start "chrome",[Webドライバーフルパス]
56
+
57
+ Driver.Get "https://www.yahoo.co.jp/"
58
+
59
+
60
+
61
+ 結果同じくたまに固まってしまいます。
62
+
63
+
64
+
65
+
66
+
67
+ またchrome起動後にポート使用可能になるまで待つように
68
+
69
+ WaitPortUse(9222)
70
+
71
+ の処理を入れましたが若干頻度は落ちましたが、やはりたまに固まります。
72
+
73
+
74
+
75
+ 固まる場合はchromeが
76
+
77
+
78
+
37
79
  ちなみに参照設定しないのはSeleniumを入れていないPCもあるので動作的に使用しています。
38
80
 
39
81
 
@@ -116,10 +158,92 @@
116
158
 
117
159
 
118
160
 
161
+ '指定ポートが反応あるまで待つ
162
+
163
+ Public Function WaitPortUse(longPort As Long) As Integer
164
+
165
+ Dim strFile As String
166
+
167
+ Dim strWork As String
168
+
169
+ Dim obj2 As Object
170
+
171
+ Dim obj3 As Object
172
+
173
+ Dim i As Integer
174
+
175
+ On Error Resume Next
176
+
177
+ 'Chromeに通信できるか確認
178
+
179
+ strFile = "c:\log\NetConnection.log"
180
+
181
+ Set obj2 = CreateObject("WScript.Shell")
182
+
183
+ obj2.Run "powershell -NoLogo -ExecutionPolicy RemoteSigned -Command Test-NetConnection 127.0.0.1 -port " & longPort & " > " & strFile, 0, True
184
+
185
+ Do While 1
186
+
187
+ 'UTF-8テキストファイルを開く
188
+
189
+ Set obj3 = CreateObject("ADODB.Stream")
190
+
191
+ obj3.Type = adTypeText
192
+
193
+ 'file1.Charset = "shift-jis"
194
+
195
+ obj3.Charset = "utf-8"
196
+
197
+ obj3.LineSeparator = adCRLF ' 改行コードの指定 -1: CRLF, 10: LF, 13: CR
198
+
199
+ obj3.Open
200
+
201
+ Call obj3.LoadFromFile(strFile)
202
+
203
+
204
+
205
+ strWork = obj3.ReadText(adReadLine)
206
+
207
+ Do While InStr(1, strWork, " ", vbTextCompare) <> 0
208
+
209
+ strWork = Replace(strWork, " ", "", , , vbTextCompare)
210
+
211
+ Loop
212
+
213
+ Do While InStr(1, strWork, Chr(0), vbTextCompare) <> 0
214
+
215
+ strWork = Replace(strWork, Chr(0), "", , , vbTextCompare)
216
+
217
+ Loop
218
+
219
+ Set obj3 = Nothing
220
+
221
+ If InStr(1, strWork, "TcpTestSucceeded:True", vbTextCompare) <> 0 Then
222
+
223
+ Exit Do
224
+
225
+ End If
226
+
227
+ For i = 1 To 20
228
+
229
+ Sleep 1000
230
+
231
+ DoEvents
232
+
233
+ Next
234
+
235
+ obj2.Run "powershell -NoLogo -ExecutionPolicy RemoteSigned -Command Test-NetConnection 127.0.0.1 -port " & longPort & " > " & strFile, 0, True
236
+
237
+ Loop
238
+
239
+ Set obj2 = Nothing
240
+
241
+ End Function
242
+
119
243
 
120
244
 
121
245
  chromeとWebDriverのバージョンは同じでした
122
246
 
123
- 複数のPCで同じ現象が発生したことがあります。OSのWindowsは8.1や10などまちまちです。
247
+ 複数のPCで同じ現象が発生したことがあります。OSのWindowsは8.1や10(x64,x86も混在)などまちまちです。
124
-
248
+
125
- Accessも2013,2016とそのPCによって違いますが同じ現象が発生しました
249
+ Accessも2013,2016(32ビット)とそのPCによって違いますが同じ現象が発生しました