［Script］［VBS］テキストファイル整形のスクリプト

テキストファイルを整形したり集計したりするスクリプト。

空白行を削除.vbs

'------------------------------------------------------------------------------
'ドラッグ＆ドロップしたテキストファイルの空白行を取り除く
'------------------------------------------------------------------------------

Set args = WScript.Arguments
strFileName = args(0)

'変換後のファイル名 = 元のファイル名_new
pos = InstrRev(strFileName, ".")
strDistFile = Left(strFileName,(pos-1)) & "_new" & Mid(strFileName, pos)

'オブジェクトの生成
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileName, 1)
Set objFile_Dist = objFSO.CreateTextFile(strDistFile)

'正規表現オブジェクトを生成
Set regEx = New RegExp
regEx.Pattern = ".+"

'元ファイルから一行ずつ読み込み、正規表現による条件分岐
Do While (objFile.AtEndOfStream <> True)
  strLineData = objFile.ReadLine
  If (regEx.Test(strLineData)) Then
    objFile_Dist.WriteLine(strLineData)
  End If
Loop

参考：

文字列操作（Instr / Mid）

先頭 x 行を削除.vbs

'------------------------------------------------------------------------------
'指定したフォルダ内のテキストファイルを一律で編集する。
'編集方法
' フォルダを選択する
' InputBox を表示し先頭と最後の何行をそれぞれ削除するか入力する。
' 編集したファイルは OutDir フォルダを作成しそこに格納。
'あとこの下にある初期定数を書いておけばダイアログを表示せずに実行できる。
'------------------------------------------------------------------------------

Option Explicit
'-----------------------------------
'===== 初期定数 =====
Const OutDir = "変換結果"
Const FirstDelLine = ""
Const EndDelLine = ""
Const FolderSelectMsg = false 'false / true
Const bTrim = false 'false / true
'-----------------------------------

' ----------------------------------------------------
' [ フォルダ選択ウインドウの option 定義 ]
'
' ディレクトリ以外は選択できないようにする。
Const BIF_RETURNONLYFSDIRS   = &H1

' ファイルも選択できるようにする。
Const BIF_BROWSEINCLUDEFILES = &H4000

' ----------------------------------------------------

Dim Rtn, strPath
Dim Fs, objFolder, objFiles, objFile, objInFile, objOutFile
Dim FirstDeleteLineNum, EndDeleteLineNum
Dim objDictionary
Dim strFilePath
Dim i, strLineData

Set Fs = WScript.CreateObject("Scripting.FileSystemObject")

' ----- スクリプト開始の確認ウインドウを表示
if MsgBox ("テキストファイルを整形します。",vbOKCancel+vbInformation,"スクリプト開始") = vbCancel then Call ExitJob("キャンセルされました。")

' ----- 対象とするフォルダを選択する
if FolderSelectMsg = false then
    strPath= Fs.GetAbsolutePathName(".")
    If Right(strPath,1) <> "\" Then strPath = strPath & "\"
else
    Rtn = MsgBox ("このスクリプトは作業フォルダにありますか", vbOkCancel)
        if Rtn = vbOk then
            'スクリプトのあるディレクトリがルート
            strPath = Fs.GetAbsolutePathName(".")
       If Right(strPath,1) <> "\" Then strPath = strPath & "\"
        else
            'ダイアログで選択（遅い）
            strPath = FolderSelect
        end if
end if

' ----- 処理内容を取得
if FirstDelLine <> "" then
    FistDeleteLineNum = CInt(FirstDelLine)
else
    Do
        FirstDeleteLineNum = InputBox ("先頭何行を削除しますか" ,,0)
        if FirstDeleteLineNum = "" then Call ExitJob("キャンセルされました。")
    Loop Until IsNumeric (FirstDeleteLineNum)
end if

if EndDelLine <> "" then
    EndDeleteLineNum = CInt(EndDelLine)
else
    Do
        EndDeleteLineNum   = InputBox ("最後何行を削除しますか" ,,0)
        if EndDeleteLineNum = "" then Call ExitJob("キャンセルされました。")
    Loop Until IsNumeric (EndDeleteLineNum)
end if

if MsgBox ("以下の情報でよろしいですか" & vbCrLf & vbCrLf & _
           "ディレクトリ： " & vbCrLf & _
  strPath & vbCrLf & vbCrLf & _
           "削除する行" & vbCrLf & _
           "    先頭" & vbTab & FirstDeleteLineNum & "行" & vbCrLf & _
           "    後ろ" & vbTab & EndDeleteLineNum & "行", vbOkCancel) _
    = vbCancel then Call ExitJob("キャンセルされました。")

' ----- 出力フォルダの作成
if Fs.FolderExists( strPath & OutDir ) then Fs.DeleteFolder( strPath & OutDir )
Fs.CreateFolder( strPath & OutDir )

' ----- テキストファイルを検索しながら処理を実行
'ファイルオブジェクトを取得
Set objFolder = Fs.GetFolder( strPath )
Set objFiles = objFolder.Files

Set objDictionary = CreateObject("Scripting.Dictionary")

For Each objFile in objFiles
    '拡張子の取得
    if Fs.GetExtensionName(objFile.Name) = "txt" then
      'テキストファイルを開く
        '読み込み用
        Set objInFile = Fs.OpenTextFile(objFile.Name)
        '書き込み用
Set objOutFile = Fs.CreateTextFile( strPath & OutDir & _
                         "\" & objFile.Name)

      'Dictionary オブジェクト初期化
        objDictionary.RemoveAll
      '先頭の切り捨て
        For i = 0 to FirstDeleteLineNum - 1
            objInFile.SkipLine
        Next

      '必要な数だけループ
        Do While objInFile.AtEndOfStream <> True
          strLineData = objInFile.ReadLine
          if bTrim = false then
              objDictionary.Add objDictionary.Count + 1, strLineData
          else
              objDictionary.Add objDictionary.Count + 1, trim(strLineData)
          end if
          if objDictionary.Count >= CInt(EndDeleteLineNum) + 1 then
            objOutFile.WriteLine(objDictionary.Item(1))
            'Dictionary オブジェクトの再構築
            Call DictRemove
          end if
        Loop

        objInFile.Close
objOutFile.Close
    end if
Next

MsgBox "終了しました"


' =======================================================================
' 終了処理

Sub ExitJob( msgstr )
    MsgBox msgstr & vbCrLf & vbCrLf & "スクリプトを終了します"
    WScript.Quit
End Sub

'フォルダ選択
Function FolderSelect()
    Dim Shell, fld
    Dim RtnPath
    Set Shell = WScript.CreateObject("Shell.Application")
    Set fld = Shell.BrowseForFolder(0, "テキストファイルの保存されているフォルダを選択してください。",BIF_RETURNONLYFSDIRS)
    If fld Is Nothing Then Call ExitJob("キャンセルされました。")
    RtnPath = fld.Items.Item.Path       ' フォルダPATH取得
    If Right(RtnPath,1) <> "\" Then RtnPath = RtnPath & "\"
    FolderSelect = RtnPath
End Function

' Dictionary オブジェクトの1件削除
'  以下のオブジェクトの先頭 1 件を削除する
'    オブジェクト名：objDictionary
'    キー：1 からの連番

Sub DictRemove()
Dim i
    objDictionary.Remove 1
    For i = 0 to objDictionary.Count - 1
      objDictionary.Key(i + 2) = i + 1
    Next
End Sub

参考：

Dictionaryオブジェクト
ファイルの読み書き（FileSystemObject）

---

Script のページに戻る