id:takanii
ポイントあり500ptベストアンサーあり
コンピュータ

VBSの質問です

a.html
***********************
<html><body><table>
<tr>
<td>hogegehogehoge</td>
<td>gehogeoj</td>
<td>banana</td>
</tr>
<tr>
<td>hogegehogehoge</td>
<td>gehogeoj</td>
<td>sakana</td>
</tr>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
</TABLE></body></html>
***********************
というファイルがあるのですが
これを各<tr></tr>の最後の<td></td>内をファイル名として以下のように
banana.html
***********************
<html><body><table>
<tr>
<td>hogegehogehoge</td>
<td>gehogeoj</td>
<td>banana</td>
</tr>
</TABLE></body></html>
***********************

sakana.html
***********************
<html><body><table>
<tr>
<td>hogegehogehoge</td>
<td>gehogeoj</td>
<td>sakana</td>
</tr>
</TABLE></body></html>
***********************

mikan.html
***********************
<html><body><table>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
</TABLE></body></html>
***********************
のように分けたいんですが
どのようなスクリプトを組めばいいでしょうか？
表の列数は行数は変化します

回答の条件
  • 1人5回まで
  • 登録：
  • 終了：2013/03/05 19:26:18
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:taknt No.1

回答回数13539ベストアンサー獲得回数1198

ポイント500pt 
Dim objFile  ' 対象ファイル
Dim objFile2 ' 出力ファイル
Dim objFSO ' ファイルシステムオブジェクト
Dim k
Dim tb()
Dim tb2()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("a.html")
k=0
Do Until objFile.AtEndOfLine = True
	strText = objFile.ReadLine
	k=k+1
	redim Preserve tb(k)
	tb(k)=strText
	if instr(strText,"</tr>") > 0 then
		a=instr(tb(k-1),"<td>")
		b=instr(a+1,tb(k-1),"</td>")
		c = mid(tb(k-1),a+4,b-5)
		Set objFile2 = objFSO.CreateTextFile(c & ".html")
		d=1
		if tb(1)="<html><body><table>" then d=2
		objFile2.WriteLine("<html><body><table>")
		for a=d to k
			objFile2.WriteLine ( tb(a) )
		next
		objFile2.WriteLine("</TABLE></body></html>")
		objFile2.Close
		k=0
		redim tb(1)
	end if

Loop
objFile.Close



>各<tr></tr>の最後の<td></td>内をファイル名
この場合、

<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>

だと それぞれ 二つに 分かれてしまうと思われますが、
これが ひとつになる条件は 何があるのでしょうか？

他3件のコメントを見る
id:taknt 
Dim objFile  ' 対象ファイル
Dim objFile2 ' 出力ファイル
Dim objFSO ' ファイルシステムオブジェクト
Dim k
Dim tb()
Dim tb2()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("a.html")
k=0
Do Until objFile.AtEndOfLine = True
	strText = objFile.ReadLine
	k=k+1
	redim Preserve tb(k)
	tb(k)=strText
	if instr(strText,"</tr>") > 0 then
		a=instr(tb(k-1),"<td>")
		b=instr(a+1,tb(k-1),"</td>")
		c = mid(tb(k-1),a+4,b-5)
		if objFSO.FileExists(c & ".html") then
			'既存ファイルがあれば追加する。
			Set objFile2 = objFSO.OpenTextFile(c & ".html")
			kk = 0
			Do Until objFile2.AtEndOfLine = True
				strText = objFile2.ReadLine
				kk=kk+1
				redim Preserve tb2(kk)
				tb2(kk) = strText
			Loop
			objFile2.Close

			Set objFile2 = objFSO.OpenTextFile(c & ".html",2)
			for e=1 to kk -1
				objFile2.WriteLine ( tb2(e) )
			next

			for a=d to k
				objFile2.WriteLine ( tb(a) )
			next
			objFile2.WriteLine("</TABLE></body></html>")
		else
			Set objFile2 = objFSO.CreateTextFile(c & ".html")
			d=1
			if tb(1)="<html><body><table>" then d=2
			objFile2.WriteLine("<html><body><table>")
			for a=d to k
				objFile2.WriteLine ( tb(a) )
			next
			objFile2.WriteLine("</TABLE></body></html>")
			objFile2.Close
		end if
		k=0
		redim tb(1)
	end if

Loop
objFile.Close

質問にあるように出力されるようにしました。

2013/03/05 18:00:52
id:takanii

大変有り難うございました！
助かりました！

2013/03/05 19:26:07

その他の回答（0件）

id:taknt No.1

回答回数13539ベストアンサー獲得回数1198ここでベストアンサー

ポイント500pt 
Dim objFile  ' 対象ファイル
Dim objFile2 ' 出力ファイル
Dim objFSO ' ファイルシステムオブジェクト
Dim k
Dim tb()
Dim tb2()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("a.html")
k=0
Do Until objFile.AtEndOfLine = True
	strText = objFile.ReadLine
	k=k+1
	redim Preserve tb(k)
	tb(k)=strText
	if instr(strText,"</tr>") > 0 then
		a=instr(tb(k-1),"<td>")
		b=instr(a+1,tb(k-1),"</td>")
		c = mid(tb(k-1),a+4,b-5)
		Set objFile2 = objFSO.CreateTextFile(c & ".html")
		d=1
		if tb(1)="<html><body><table>" then d=2
		objFile2.WriteLine("<html><body><table>")
		for a=d to k
			objFile2.WriteLine ( tb(a) )
		next
		objFile2.WriteLine("</TABLE></body></html>")
		objFile2.Close
		k=0
		redim tb(1)
	end if

Loop
objFile.Close



>各<tr></tr>の最後の<td></td>内をファイル名
この場合、

<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>
<tr>
<td>hogehogehohoge</td>
<td>hogehogehogehoge</td>
<td>mikan</td>
</tr>

だと それぞれ 二つに 分かれてしまうと思われますが、
これが ひとつになる条件は 何があるのでしょうか？

他3件のコメントを見る
id:taknt 
Dim objFile  ' 対象ファイル
Dim objFile2 ' 出力ファイル
Dim objFSO ' ファイルシステムオブジェクト
Dim k
Dim tb()
Dim tb2()

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("a.html")
k=0
Do Until objFile.AtEndOfLine = True
	strText = objFile.ReadLine
	k=k+1
	redim Preserve tb(k)
	tb(k)=strText
	if instr(strText,"</tr>") > 0 then
		a=instr(tb(k-1),"<td>")
		b=instr(a+1,tb(k-1),"</td>")
		c = mid(tb(k-1),a+4,b-5)
		if objFSO.FileExists(c & ".html") then
			'既存ファイルがあれば追加する。
			Set objFile2 = objFSO.OpenTextFile(c & ".html")
			kk = 0
			Do Until objFile2.AtEndOfLine = True
				strText = objFile2.ReadLine
				kk=kk+1
				redim Preserve tb2(kk)
				tb2(kk) = strText
			Loop
			objFile2.Close

			Set objFile2 = objFSO.OpenTextFile(c & ".html",2)
			for e=1 to kk -1
				objFile2.WriteLine ( tb2(e) )
			next

			for a=d to k
				objFile2.WriteLine ( tb(a) )
			next
			objFile2.WriteLine("</TABLE></body></html>")
		else
			Set objFile2 = objFSO.CreateTextFile(c & ".html")
			d=1
			if tb(1)="<html><body><table>" then d=2
			objFile2.WriteLine("<html><body><table>")
			for a=d to k
				objFile2.WriteLine ( tb(a) )
			next
			objFile2.WriteLine("</TABLE></body></html>")
			objFile2.Close
		end if
		k=0
		redim tb(1)
	end if

Loop
objFile.Close

質問にあるように出力されるようにしました。

2013/03/05 18:00:52
id:takanii

大変有り難うございました！
助かりました！

2013/03/05 19:26:07
id:takanii

質問者から

takanii2013/03/05 19:02:36

質問文を編集しました。詳細はこちら。

規約違反として通知

コメント（0件)

コメントはまだありません

この質問への反応（ブックマークコメント）

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません
ユーザー登録をして使いはじめる!無料
すでに登録されている方はこちらからログイン
この質問に含まれるキーワード
知りたいことを検索してみよう
▲ページトップへ