エクセルVBAでマクロを開発しているのですが、プログラムの最後に全てのIEを閉じるコードを書いたのですが、エラーになってしまいます。エラーにはなりますが、タスクマネージャーでIEプロセスの起動を確認した所、全て終了していたので、目的は達成しております。しかし、コードを実行すると、"オブジェクト変数または、Withブロック変数が設定されていません"とエラーが出てしまいます。
実際のコードは下記になります。
以下エクセルVBAのコードになります。
Dim Search As String Private Sub CommandButton1_Click() Dim ELInteger2 As Integer Dim ELInteger As Integer Dim ELStringer5 As String Dim ELStringer4 As String Dim ELStringer3 As String Dim ELStringer2 As String Dim ELStringer As String Dim SPDate3 As String Dim SPDate2 As String Dim SPDate As String Dim Colect5 As IHTMLElementCollection Dim Colect4 As IHTMLElementCollection Dim Colect3 As IHTMLElementCollection Dim Colect2 As IHTMLElementCollection Dim Colect As IHTMLElementCollection Dim interNet5 As InternetExplorer Dim interNet4 As InternetExplorer Dim interNet3 As InternetExplorer Dim interNet2 As InternetExplorer Dim interNet As InternetExplorer Dim HTMLD4 As HTMLDocument Dim HTMLD3 As HTMLDocument Dim HTMLD2 As HTMLDocument Dim HTMLD As HTMLDocument Dim Sisokuenzan As String Dim kasan As String Dim ELInteger10 As Integer ELInteger10 = 0 ELIntegerB = 0 ELIntegerC = 0 ELInteger = 0 ELIntegerCount6 = 4 ELIntegerCount5 = 4 ELIntegerCount4 = 4 ELIntegerCount3 = 4 ELIntegerCount2 = 4 ELIntegerCount1 = 4 Dim ELIntegerCountStringer1 As String Dim ELIntegerCountStringer2 As String Dim ELIntegerCountStringer3 As String Dim ELIntegerCountStringer4 As String Dim ELIntegerCountStringer5 As String Dim ELIntegerCountStringer6 As String 'ブランド抽出処理 Set interNet2 = CreateObject("Internetexplorer.Application") interNet2.Visible = False kasan = ".html" Sisokuenzan = Search + kasan interNet2.navigate "http://www.buyma.com/brand/" & Sisokuenzan Do While interNet2.Busy = True Or interNet2.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD = interNet2.document Set Colect = HTMLD.getElementsByClassName("vmimg_120") '各ブランドのバイヤーTop3展開処理 For Each EL In Colect SPDate = EL.innerHTML ELStringer = Mid(SPDate, 95) ELInteger = InStr(ELStringer, "l") ELStringer2 = Left(ELStringer, ELInteger) '各ブランドのTop3バイヤー取得処理 Set interNet3 = CreateObject("Internetexplorer.Application") interNet3.Visible = False interNet3.navigate ELStringer2 Do While interNet3.Busy = True Or interNet3.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD2 = interNet3.document Set Colect2 = HTMLD2.getElementsByClassName("profimg_wrap") '各ブランドのTop3バイヤー表示処理 For Each El2 In Colect2 SPDate2 = El2.innerHTML ELStringer3 = Mid(SPDate2, 14) ELInteger2 = InStr(ELStringer3, "http") ELInteger4 = ELInteger2 ELStringer4 = Left(ELStringer3, ELInteger4) ELIntegerA = InStr(ELStringer4, "alt") + 5 ELInteger6 = InStr(ELIntegerA, ELStringer4, """") ELInteger8 = ELInteger6 - ELIntegerA ELStringer5 = Mid(ELStringer4, ELIntegerA, ELInteger8) Next El2 'ランキング表示処理 ELInteger10 = ELInteger10 + 1 If ELInteger10 = 1 Then Range("A1").Value = "ランキング1位:" & ELStringer5 ElseIf ELInteger10 = 2 Then Range("D1").Value = "ランキング2位:" & ELStringer5 ElseIf ELInteger10 = 3 Then Range("G1").Value = "ランキング3位:" & ELStringer5 End If 'バイヤー別売上ランキング取得処理 ELInteger12 = InStr(ELStringer4, ".html") - 1 ELStringer13 = Left(ELStringer4, ELInteger12) Set interNet4 = CreateObject("Internetexplorer.Application") interNet4.Visible = False interNet4.navigate "http://www.buyma.com/" & ELStringer13 + "/sales_1.html" Do While interNet4.Busy = True Or interNet4.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD3 = interNet4.document Set Colect3 = HTMLD3.getElementsByClassName("data_line0") Set HTMLD4 = interNet4.document Set Colect4 = HTMLD4.getElementsByClassName("data_line1") 'デバッキング処理 For Each ELD In Colect3 ELStringer15 = ELD.innerHTML Debug.Print ELStringer15 ELStringer17 = Mid(ELStringer15, 168) Debug.Print ELInteger17 ELInteger18 = InStr(ELStringer17, """>") Debug.Print ELInteger18 ELStringer20 = Left(ELStringer17, ELInteger18) Debug.Print ELStringer20 ELInteger100 = Len(ELStringer20) ELInteger200 = ELInteger100 - 2 ELStringer24 = Left(ELStringer20, ELInteger200) Debug.Print ELStringer24 ELInteger2000 = Len(ELStringer24) ELInteger4000 = ELInteger2000 - 15 ELStringer1000 = Right(ELStringer24, ELInteger4000) Debug.Print ELStringer1000 Set interNet5 = CreateObject("Internetexplorer.Application") interNet5.Visible = False interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000 Next ELD '商品リスト展開メインルーチン ELIntegerB = ELIntegerB + 1 If ELIntegerB = 1 Then For Each El3 In Colect3 ELIntegerCount1 = ELIntegerCount1 + 1 ELIntegerCountStringer1 = ELIntegerCount1 SPDate10 = El3.innerText Range("A" & ELIntegerCountStringer1).Value = SPDate10 Next El3 ElseIf ELIntegerB = 2 Then For Each El4 In Colect3 ELIntegerCount2 = ELIntegerCount2 + 1 ELIntegerCountStringer2 = ELIntegerCount2 SPDate10 = El4.innerText Range("C" & ELIntegerCountStringer2).Value = SPDate10 Next El4 ElseIf ELIntegerB = 3 Then For Each El5 In Colect3 ELIntegerCount3 = ELIntegerCount3 + 1 ELIntegerCountStringer3 = ELIntegerCount3 SPDate10 = El5.innerText Range("E" & ELIntegerCountStringer3).Value = SPDate10 Next El5 End If '商品リスト2展開メインルーチン ELIntegerC = ELIntegerC + 1 If ELIntegerC = 1 Then For Each El6 In Colect4 ELIntegerCount4 = ELIntegerCount4 + 1 ELIntegerCountStringer4 = ELIntegerCount4 SPDate11 = El6.innerText Range("B" & ELIntegerCountStringer4).Value = SPDate11 Next El6 ElseIf ELIntegerC = 2 Then For Each El7 In Colect4 ELIntegerCount5 = ELIntegerCount5 + 1 ELIntegerCountStringer5 = ELIntegerCount5 SPDate11 = El7.innerText Range("D" & ELIntegerCountStringer5).Value = SPDate11 Next El7 ElseIf ELIntegerC = 3 Then For Each El8 In Colect4 ELIntegerCount6 = ELIntegerCount6 + 1 ELIntegerCountStringer6 = ELIntegerCount6 SPDate11 = El8.innerText Range("F" & ELIntegerCountStringer6).Value = SPDate11 Next El8 End If '初期化処理 ELIntegerD = ELIntegerD + 1 If ELIntegerD = 3 Then ELInteger10 = 0 ELIntegerB = 0 ELIntegerC = 0 ELIntegerD = 0 'Dim ObjectShell As Object 'Dim QuiteObject As Object 'Dim CountInteger As Integer 'Set ObjectShell = CreateObject("Shell.Application") 'For CountInteger = ObjectShell.Windows.Count To 1 Step -1 'Set QuiteObject = ObjectShell.Windows(CountInteger - 1) 'If Right(UCase(QuiteObject.FullName), 12) = "IEXPLORE.EXE" Then 'QuiteObject.Quit 'End If 'Next Dim SHE As Object Dim QIT As Object Dim CIG As Integer Set SHE = CreateObject("Shell.Application") For CIG = SHE.Windows.Count To 1 Step -1 Set QIT = SHE.Windows(CIG - 1) If QIT = "iexplore.exe" Then QIT.Quit End If Next End If Next EL End Sub 'スクレイピングスタート Private Sub CommandButton2_Click() End Sub 'バイヤー抽出 Private Sub CommandButton3_Click() End Sub Private Sub TextBox1_Change() Search = TextBox1.Value End Sub Private Sub UserForm_Click() End Sub
ここまでです。
何故この様なエラーが出るのでしょうか?。詳しい方、ご教示して頂ければと思います。
宜しくお願い致します。
回答1件
あなたの回答
tips
プレビュー