フォルダ内のCSVファイルをすべて読み込み、先頭７行削除、最後の行を削除したい

Question

【1】あるフォルダ内にあるCSVファイルのみを全て読み込み
【2】読み込んだ全てのファイルの先頭７行を削除、最終行を削除して保存

するスクリプトをVBSで作成しています。

ファイル名は全て取り出せたのですが、ファイルの行数を取得する際に、一つのファイルを読んだら、
処理が終了してしまいました。

おそらく、Do While ～ の中の処理がうまくいってないと思われます。
できれば、先頭７行削除、最終行を削除して保存する方法も合わせてご教授願いたいと思います。

下記に自分で作成したプログラムを記述しますので、宜しくお願い致します。

'ファイルシステムオブジェクト定義
Dim	objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'カレントパス取得
Dim objPath
Set objPath = CreateObject("Scripting.FileSystemObject").GetFolder(".")


For Each objFile In objPath.Files
	
	Dim FileName
	FileName	=	objFile.Name
	'WScript.Echo FileName
	
	If InStr(FileName, ".csv") > 0 Then
    '文字列の中に".csv"の文字があればここの処理が行われます。
		Call FileRead(FileName)
	End If

Next

Sub FileRead(FileNameA)

	Dim objFSO      ' FileSystemObject
	Dim objFile     ' ファイル読み込み用

	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	If Err.Number = 0 Then
    	Set objFile = objFSO.OpenTextFile(FileNameA)
    If Err.Number = 0 Then
    	count	= 0
        Do While objFile.AtEndOfStream <> True
        
        	
        
        
        	count = count + 1
        	If	count	< 8	Then
                WScript.Echo FileNameA	&	objFile.ReadLine
            End	If
            
            
            
        Loop
        objFile.Close
    Else
        WScript.Echo "ファイルオープンエラー: " & Err.Description
    End If
Else
    WScript.Echo "エラー: " & Err.Description
End If

Set objFile = Nothing
Set objFSO = Nothing

        'MsgBox "ファイル名:" & FileNameA


End Sub

Answer 1

フォルダの作成はコメントアウトしてあるようですがCreateFolderでできませんでしたか？
もし同名フォルダが存在した場合にエラーとなっているのであれば、既存フォルダーの存在チェックをしてから作成すればいいと思います。

objFso.FolderExists(".\Edit") 

ファイル出力に関しては、出力ファイル用にオブジェクトを作成し、ループ内で条件を満たす場合に書き込んであげればいいと思います。

'出力ファイルの作成 （出力ファイルが変わるたびに新規作成）
Set objWriteFile = objFSO.CreateTextFile(strOutFilePath, true) '新規ファイル作成

(以下ループ処理内)
   strText = objFile.ReadLine
   If objFile.AtEndOfStream <> True And count > 8 Then
     objWriteFile.WriteLine(strText) '１行出力
   End If

Comments

[jawa]

解決済みでしたね、すみません。

[kumakumatan]

ありがとうございます。
ご参考にさせていただきます。

Answer 2

質問しているうちに自分がやりたい処理が作成する事ができました。

======VBS=====
If MsgBox("先頭から７行と最後の行を削除する処理を実行します！" & _
vbCrLf & vbCrLf & _
"[OK]を選択した場合は処理が開始されます。" & _
"[キャンセル]を選択した場合は何も処理されません。", _
vbOKCancel + vbQuestion, "ファイル操作処理の確認") = vbOK Then

'MsgBox "ファイル操作処理が開始されました！", _
'	     vbOKOnly + vbInformation, "ファイル操作処理開始"

'ファイルシステムオブジェクト定義
Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'カレントパス取得
Dim objPath
Set objPath = CreateObject("Scripting.FileSystemObject").GetFolder(".")

Dim strFormattedDate	'日付取得

Dim wkNow
	wkNow= Year(Now())
	wkNow= wkNow & Right("0" & Month(Now()) , 2)
	wkNow= wkNow & Right("0" & Day(Now()) , 2)
	wkNow= wkNow & Right("0" & Hour(Now()) , 2)
	wkNow= wkNow & Right("0" & Minute(Now()) , 2)
	wkNow= wkNow & Right("0" & Second(Now()) , 2)

strFormattedDate =	wkNow

'"yyyymmddhhmmss_Edit" というフォルダを作成する

strFormattedDate	= strFormattedDate	&	"_Edit"

If objFSO.FolderExists(strFormattedDate) = True Then
    strMessage = "フォルダ " & strFormattedDate & " は既に存在しています。"
Else	
	objFSO.CreateFolder(strFormattedDate)
	strMessage = "フォルダ " & strFormattedDate & " を作成しました。"
End	If	

' WScript.Echo strMessage

'CSVファイルの読み込み件数をカウント
For Each objFile In objPath.Files

Dim FileName
	FileName	=	objFile.Name
	
	
	
If InStr(FileName, ".csv") > 0 Then
'文字列の中に".csv"の文字があればここの処理が行われます。
	
	FileCnt	=	FileCnt	+	1
	
	writeFile	=	strFormattedDate	&	"\"	&	FileName	'作成ファイル指定
	'WScript.Echo FileName

	Set fso = CreateObject("Scripting.FileSystemObject")
	Set fileIn = fso.OpenTextFile(FileName)
	
	count = 0	'読み込みRead件数
	Do While fileIn.AtEndOfStream	<>	True
	
		count = count + 1
		fileIn.Readline	'読み込み命令

	Loop
		fileIn.Close	'読み込みファイル閉じる
	
		'ファイル書き込み処理を呼び出し
		Call FileWrite(FileName,strFormattedDate,count,writeFile)
End If

Next

WScript.Echo "読み込みファイル数"	&	FileCnt	&	"件"

Sub FileWrite(FileNameA,DateA,countA,writeFileA)

WScript.Echo FileNameA	&	countA	&	"行"
'WScript.Echo FileNameA	&	countB	&	"行"




Set fso = CreateObject("Scripting.FileSystemObject")
Set fileIn = fso.OpenTextFile(FileNameA)	'読み込みファイル
Set fileOut = fso.CreateTextFile(writeFileA)	'書き込みファイル


	countB = 0	'書き込み件数
	Do While Not fileIn.AtEndOfStream
	
		countB = countB + 1
		'先頭と末尾の両方のスペースを削除した文字列を返す
		line = Trim(fileIn.ReadLine)
		
		If	countB	> 7 and countB < CountA Then	'先頭７行、最終行の1行前までを書き込む条件
		
			fileOut.Write line
			fileOut.WriteLine
		
		End	If		

	Loop
		'fileOut.WriteLine   '改行
		
		fileIn.Close	'読み込みファイル閉じる
		fileOut.Close	'読み込みファイル閉じる

	

End Sub

End If '処理終了
========VBS終了======

今後とも宜しくお願いします。

Answer 3

FileRead関数の中で

If Err.Number = 0 Then
   Set objFile = objFSO.OpenTextFile(FileNameA) 
If Err.Number = 0 Then 

の最初のIf Err.Number = 0 ThenのEndifが見当たりませんが。

Comments

[kumakumatan]

'ファイルシステムオブジェクト定義
Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'カレントパス取得
Dim objPath
Set objPath = CreateObject("Scripting.FileSystemObject").GetFolder(".")

'"Edit" というフォルダを作成する
'str_path = objFSO.CreateFolder(".\Edit")

For Each objFile In objPath.Files

Dim FileName
FileName = objFile.Name
'WScript.Echo FileName

If InStr(FileName, ".csv") > 0 Then
'文字列の中に".csv"の文字があればここの処理が行われます。
Call FileRead(FileName)
End If

Next

Sub FileRead(FileNameA)

Dim objFSO ' FileSystemObject
Dim objFile ' ファイル読み込み用

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
Set objFile = objFSO.OpenTextFile(FileNameA)
If Err.Number = 0 Then
count = 0
Do While objFile.AtEndOfStream <> True

count = count + 1
If count < 8 Then
WScript.Echo FileNameA & objFile.ReadLine

ELSE
'次の処理へ
Exit Do

End If

Loop
objFile.Close
Else
WScript.Echo "ファイルオープンエラー: " & Err.Description
End If
Else
WScript.Echo "エラー: " & Err.Description
End If

Set objFile = Nothing
Set objFSO = Nothing

'MsgBox "ファイル名:" & FileNameA

End Sub

作成し直して、1行目から７行目までの行内容を表示する事ができました。

やりたい事をするには以下の方法でするべきでしょうか？

【1】新しいフォルダを作成
【2】ファイルを読み込み、1行目～７行目、最後の行以外を新しいフォルダ内に
　　　ファイルを作成して、書き込む。

読み込み処理と、書き込み処理は無ずかいしいでしょうか？

宜しくお願いします。

[jawa]

>最初のIf Err.Number = 0 ThenのEndifが見当たりませんが。

段組みがずれていますが、最後の
```
Else
WScript.Echo "エラー: " & Err.Description
End If
```
が受けているようですね。