VBA100本ノックの100本目をやってみた

VBAで作ったみた。

Sub Macro1()
    'IEを起動する
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    'IEの位置・大きさの設定、IEを表示
    objIE.Top = 10: objIE.Left = 6160: objIE.Width = 800: objIE.Height = 900
    objIE.Visible = True
    
    objIE.Navigate "https://excel-ubara.com/vba100sample/vba100list.html"
    Call untilReady(objIE)
    'VBA100本ノック目次のtableをとってくる
    Set objTable = objIE.Document.getElementsBytagname("table")
    x_html = objTable(0).outerHTML
    'IEを閉じる
    objIE.Quit
    Set objIE = Nothing
    
    'クリップボードにコピー
    Dim CB As New DataObject
    CB.SetText x_html
    CB.PutInClipboard
    'Sheet1にペーストする
    Set oSheet = ThisWorkbook.Worksheets(1)
    oSheet.Range("A1").PasteSpecial Paste
End Sub
Sub untilReady(objIE As Object)
    Do While objIE.Busy = True Or objIE.ReadyState <> 4
        DoEvents
    Loop
End Sub

DOSバッチ・VBScriptで作ったみた。

<!-- :
@%windir%\System32\cscript.exe //nologo "%~f0?.wsf"
@exit /b %errorlevel%
-->
<job>
<script language="VBScript">
	'このファイルのあるディレクトリをカレントディレクトリに
	Set objShell = Wscript.CreateObject("WScript.shell")
	Set fso      = Wscript.CreateObject("Scripting.FileSystemObject")
	CurrentDirectory = fso.getParentFolderName(WScript.ScriptFullName)

	'IEを起動する
	Dim objIE
	Set objIE = WScript.CreateObject("InternetExplorer.Application")

	'IEの位置・大きさの設定、IEを表示
	objIE.Top = 10: objIE.Left = 6160: objIE.Width = 800: objIE.Height = 900
	objIE.Visible = True

	objIE.Navigate "https://excel-ubara.com/vba100sample/vba100list.html"
	Call untilReady(objIE)
	'VBA100本ノック目次のtableをとってくる
	Set objTable = objIE.Document.getElementsBytagname("table")
	x_html = objTable(0).outerHTML
	'IEを閉じる
	objIE.Quit
	Set objIE = Nothing

	'クリップボードにコピー
	objShell.Exec("clip").StdIn.Write x_html

	'Excel起動
	Set oXlsApp = WScript.CreateObject("Excel.Application")
	'Excelの位置・大きさの設定、Excelを表示
	oXlsApp.Top = 10: oXlsApp.Left = 4460: oXlsApp.Width = 600: oXlsApp.Height = 400
	oXlsApp.Visible = True

	'新規にブックを作成
	Set objWorkbook = oXlsApp.Workbooks.Add
	'Sheet1にペーストする
	Set oSheet = objWorkbook.Worksheets(1)
	oSheet.Range("A1").PasteSpecial Paste
	
	'ブックを名前をつけて保存
	oXlsApp.DisplayAlerts = False
	objWorkbook.SaveAs(fso.BuildPath(CurrentDirectory,"test.xlsx"))
	oXlsApp.DisplayAlerts = True

	'Excelを閉じる
	oXlsApp.Quit
	Set oXlsApp = Nothing


Sub untilReady(objIE)
	'IEがページをロードし終えるのを待つ
	Do While objIE.Busy = True Or objIE.ReadyState <> 4
	WScript.Sleep 1000
	Loop
End Sub

</script>
</job>