改行コードを認識して(LFにまるめて)ファイルを一行ずつ読む方法。
(全行を一旦配列に読み込む方式となってしまう)
UTF-8も対応(先頭のBOMで認識)。
┌──────────────────────────────────────┐
│Const adTypeBinary = 1 ' バイナリとして読込 │
│Const adTypeText = 2 ' テキストとして読込 │
│Const adReadAll = -1 ' 全行読込 │
│Const adReadLine = -2 ' 一行読込 │
│Const adCR = 13 ' 改行CR │
│Const adCRLF = -1 ' 改行CRLF │
│Const adLF = 10 ' 改行LF │
│'***************************************************************************│
│' メイン処理 │
│'***************************************************************************│
│Dim objFile, theLine │
│Set objFile = New ClassFile │
│objFile.Init("ファイルパス") ' ★ファイルパスを指定 │
│Set theLine = objFile.Fetch() ' 明細行一件目読込 │
│Do While Not theLine Is Nothing │
│ ' ★処理を実装 │
│ Set theLine = objFile.Fetch() ' 明細行二件目以降読込 │
│Loop │
│Set objFile = Nothing │
│WScript.Quit(0) │
│'***************************************************************************│
│' クラス：データベース │
│'***************************************************************************│
│Class ClassFile │
│ Private mIsOk, mLines, mIndex, mPath │
│ '=======================================================================│
│ ' コンストラクタ │
│ '=======================================================================│
│ Private Sub Class_Initialize │
│ mIsOk = False │
│ Set mObjStream = WScript.CreateObject("ADODB.Stream") │
│ ' ★改行コード(以下のいずれかを指定) │
│ mObjStream.LineSeparator = adCR ' 改行CR │
│ mObjStream.LineSeparator = adCRLF ' 改行CRLF(既定) │
│ mObjStream.LineSeparator = adLF ' 改行LF │
│ End Sub │
│ '=======================================================================│
│ ' 準コンストラクタ │
│ '=======================================================================│
│ Public Sub Init(inPath) │
│ mPath = inPath │
│ '-------------------------------------------------------------------│
│ Dim allText │
│ Dim objStream: Set objStream = WScript.CreateObject("ADODB.Stream")│
│ '-------------------------------------------------------------------│
│ ' 文字コード識別(先頭BOMでUTF-8を) │
│ '-------------------------------------------------------------------│
│ If IsExistBom(inPath) Then │
│ objStream.Charset = "UTF-8" │
│ Else │
│ objStream.Charset = "SHIFT_JIS" │
│ End If │
│ '-------------------------------------------------------------------│
│ ' 全件読込 │
│ '-------------------------------------------------------------------│
│ With objStream │
│ .Type = adTypeText │
│ .Open │
│ .LoadFromFile inPath │
│ .Position = 0 │
│ allText = .ReadText(adReadAll) │
│ .Close │
│ End With │
│ '-------------------------------------------------------------------│
│ ' 改行コードをLFに統一し配列化 │
│ '-------------------------------------------------------------------│
│ allText = Replace(allText, vbCrLf, vbLf, 1, -1, vbBinaryCompare)'CRLF→LF
│ allText = Replace(allText, vbCr, vbLf, 1, -1, vbBinaryCompare) 'CR →LF
│ mLines = Split(allText, vbLf, -1, vbBinaryCompare) │
│ mIndex = 0 │
│ '-------------------------------------------------------------------│
│ ' ヘッダ読込 │
│ '-------------------------------------------------------------------│
│ mIsOk = True │
│ If Not ReadHeader() Then │
│ mIsOk = False │
│ End If │
│ End Sub │
│ '=======================================================================│
│ ' 内部メソッド：ヘッダの読込 │
│ '=======================================================================│
│ Private Function ReadHeader() │
│ If mIndex >= UBound(mLines) Then │
│ MsgBox "空っぽです" & vbCrLf & mPath, vbCritical, "エラー" │
│ ReadHeader = False │
│ Exit Function │
│ End If │
│ Do Until mIndex >= UBound(mLines) │
│ If mLines(mIndex) = "ID,…" Then ' ★想定する見出と照合 │
│ ReadHeader = True │
│ mIndex = mIndex + 1 ' 次へ │
│ Exit Function │
│ End If │
│ mIndex = mIndex + 1 ' 次へ │
│ Loop │
│ MsgBox "これは対象ファイルではありません。" & vbCrLf _ │
│ & vbCrLf _ │
│ & mPath, vbCritical, "処理スキップ" │
│ ReadHeader = False │
│ End Function │
│ '=======================================================================│
│ ' デストラクタ │
│ '=======================================================================│
│ Private Sub Class_Terminate │
│ End Sub │
│ '=======================================================================│
│ ' メソッド：実行 │
│ '=======================================================================│
│ Public Function Fetch() │
│ If Not mIsOk Then │
│ Set Fetch = Nothing │
│ Exit Function │
│ End If │
│ '-------------------------------------------------------------------│
│ ' EOF │
│ If mIndex >= UBound(mLines) Then │
│ Set Fetch = Nothing │
│ Exit Function │
│ End If │
│ '-------------------------------------------------------------------│
│ Set Fetch = mLines(mIndex) │
│ mIndex = mIndex + 1 ' 次へ │
│ End Function │
│ '=======================================================================│
│ ' 内部メソッド：BOMの存在チェック │
│ '=======================================================================│
│ Private Function IsExistBom(inPath) │
│ Dim objStream: Set objStream = WScript.CreateObject("ADODB.Stream")│
│ Dim bin, data │
│ bin = vbNullString │
│ With objStream │
│ .Type = adTypeBinary │
│ .Open │
│ .LoadFromFile inPath │
│ .Position = 0 │
│ If .Size >= 3 Then │
│ data = .Read(3) │
│ bin = Hex(AscB(MidB(data, 1, 1))) _ │
│ & Hex(AscB(MidB(data, 2, 1))) _ │
│ & Hex(AscB(MidB(data, 3, 1))) │
│ End If │
│ .Close │
│ End With │
│ IsExistBom = (bin = "EFBBBF") │
│ End Function │
│ '=======================================================================│
│End Class │
└──────────────────────────────────────┘
