質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.48%

  • VBScript

    289questions

    VBScript(Visual Basic Scripting Edition)はMicrosftが開発したスクリプト言語であり、Visual Basicのサブセットです。

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

解決済

回答 3

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 18K+

kumakumatan

score 142

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

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

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

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

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

'ファイルシステムオブジェクト定義
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
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

check解決した方法

0

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

======VBS=====
If MsgBox("先頭から7行と最後の行を削除する処理を実行します!" & _
          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    '先頭7行、最終行の1行前までを書き込む条件

                fileOut.Write line
                fileOut.WriteLine

            End    If        

        Loop
            'fileOut.WriteLine   '改行

            fileIn.Close    '読み込みファイル閉じる
            fileOut.Close    '読み込みファイル閉じる

End Sub

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

FileRead関数の中で

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


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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/01/21 18:16

    'ファイルシステムオブジェクト定義
    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行目から7行目までの行内容を表示する事ができました。

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

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

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

    宜しくお願いします。

    キャンセル

  • 2016/01/22 10:37

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

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

    キャンセル

0

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

objFso.FolderExists(".\Edit")

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/01/22 15:24

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

    キャンセル

  • 2016/01/22 15:51

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

    キャンセル

同じタグがついた質問を見る

  • VBScript

    289questions

    VBScript(Visual Basic Scripting Edition)はMicrosftが開発したスクリプト言語であり、Visual Basicのサブセットです。