Option Explicit

Dim inp
Dim fso
Dim readLine

inp = InputBox("ファイル名を入力してください。", "入力")
 
' ファイルシステムオブジェクト
Set fso = CreateObject("Scripting.FileSystemObject")

'入力ファイル
Dim inpFile
Set inpFile = fso.OpenTextFile(inp, 1)

'出力ファイル
Dim outFile
Set outFile = fso.openTextFile(inp & "_out.txt", 2, true,0) 

' 入力ファイルから一行ずつ読み込み
Do While Not inpFile.AtEndOfLine
	' 一行読み込み
	readLine = inpFile.ReadLine

	if mid(readLine,1,1) = "1" then

		outFile.WriteLine(CStr(readLine))

	end if 

	'無限ループ防止
	If Err.Number <> 0 Then WScript.Quit
Loop


'ファイルを閉じる
inpFile.Close


'ファイルを閉じる
outFile.Close 

msgbox "処理は終わりました"