2022年2月24日木曜日

dats

 -- Sep0 ----- STEPA ------------------

#
  - FILE INFO -------------------------
  FILEA 1223,451     121  23331
  FILEB 1223,452     122  23332
  FILEC 1223,453     123  23333
  CNTEND
--- Sep1 ----- STEPB ------------------
#
  - FILE INFO -------------------------
  FILEA 1223,454     124  23334
  FILEB 1223,455     125  23335
  CNTEND
#
#

ウイルス フリー。 www.avast.com

fileio




Sub fileio()


'MsgBox "aaaaaa"



'WScript.Echo "TEST開始"
If TestFileCopy = 0 Then
   ' WScript.Echo "コピー正常"
Else
    'WScript.Echo "コピー異常"
End If
WScript.Echo "TEST終了"
WScript.Quit (0)

End Sub



Function TestFileCopy()
'----------------------------------------------------
'TEST testIn.csv copy to testOut.csv
'----------------------------------------------------
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim strPathIn
Dim strPathOut
Dim fs, fr, fw
Dim intSts

    strPathIn = "testIn.csv"
    strPathOut = "testOut.csv"
   
    strPathIn = "C:\Users\Forza1063\Desktop\fileio\testIn.txt"
    strPathOut = "C:\Users\Forza1063\Desktop\fileio\testOut.txt"
   
   
    Set fs = CreateObject("Scripting.FileSystemObject")

    If fs.fileexists(strPathIn) Then
        Set fr = fs.OpenTextFile(strPathIn, ForReading)
        Set fw = fs.OpenTextFile(strPathOut, ForWriting, True)

        i = 1
       
        sFG = ""
       
        Do While Not fr.AtEndOfStream
       
            sRec = fr.ReadLine

            strSearch = "Sep" ' 検索ワード
            If InStr(sRec, strSearch) > 0 Then
               sFG = "1"
            End If
           
            strSearch = "CNTEND"
            If InStr(sRec, strSearch) > 0 Then
               sFG = "0"
            End If
           
            If sFG = "1" Then
               fw.WriteLine i & " " & sRec
            End If
           
            'fw.WriteLine sRec
           
            i = i + 1
        Loop

        fw.Close
        fr.Close
        Set fw = Nothing
        Set fr = Nothing
        intSts = 0
    Else
        Call MsgBox("ファイル見つからない!", 48, "エラー")
        intSts = 1
    End If
    Set fs = Nothing
    TestFileCopy = intSts
End Function