'------------------------------------------------------------------------------
'QRR[heLXgo̓XNvg
'                                                              TechnoStyle,inc.
'
'eLXgt@CQRR[h̓eo͂܂B
'11t@Cŏo͂܂BOtf[^J}؂ňȉ̂悤ɏo͂
'B
'ԍ,i,,z
'
'o͏ꏊ́Aȉ̃XNvǵuConst WriteFolderName = "C:\Test\f[^\"v
'ꏊɏo͂܂BύXꍇ̓pXĂB
'
't@ĆAuԍ.txtvŏo͂܂B̃t@C݂ꍇ́A
'uԍ_0001.txtv̂悤ɘAԂtt@CƂ܂B
'------------------------------------------------------------------------------
Option Explicit

Const WriteFolderName = "C:\Test\f[^\"
Const ForReading = 1, ForWriting = 2, ForAppending = 8

Call Main

'------------------------------------------------------------------------------
'C
'------------------------------------------------------------------------------
Sub Main

    Dim fs
    Dim wfile

    'QRR[hȂꍇ͏I ---------------------------------------
    If "{%SYNBOL_COUNT(QRR[hǂݎ1)}" = "0" Then
        Exit Sub
    End If

    Set fs = CreateObject("Scripting.FileSystemObject")

    'ԍt@Cɂĕۑ -------------------------------------------
    Set wfile = Fs.CreateTextFile(GetFileName(WriteFolderName & _
                      "{%N_DATA(QRR[hǂݎ1.ԍ)}" & ".txt"), True)

    'J}؂Ńf[^o -----------------------------------------------
    wfile.WriteLine "{%N_DATA(QRR[hǂݎ1.ԍ)}" & "," & _
                    "{%N_DATA(QRR[hǂݎ1.i)}" & "," & _
                    "{%N_DATA(QRR[hǂݎ1.)}" & "," & _
                    "{%N_DATA(QRR[hǂݎ1.z)}"

    wfile.Close

End Sub

'------------------------------------------------------------------------------
'@\       t@C̑݃`FbNsAt@C݂ꍇ̓t@C
'           ɘAԂtdȂt@C쐬ԋpB
'       vFileName   t@C
'߂l     dȂt@C
'------------------------------------------------------------------------------
Function GetFileName(vFileName)

    Dim fso
    Dim ItemArray
    Dim Extension
    Dim FileName
    Dim WkFileName
    Dim No
    Dim ZeroString

    't@C̊gq擾 -------------------------------------------------
    ItemArray = Split(vFileName,".")
    Extension = ItemArray(UBound(ItemArray))

    't@C̊gq̑ÕpX擾 ---------------------------------------
    FileName = Left(vFileName, Len(vFileName) - (Len(Extension) + 1))

    No = 1
    WkFileName = vFileName

    Set fso = CreateObject("Scripting.FileSystemObject")

    't@C̑݃`FbN ---------------------------------------------------
    Do Until Not (fso.FileExists(WkFileName)) 

        '[peBȌ -------------------------------------------------
        If Len(CStr(No)) < 4 Then
            ZeroString = String(4 - Len(CStr(No)),"0")
        Else
            ZeroString = ""
        End If

        't@Cɔԍt -----------------------------------------------
        WkFileName = FileName & "_" & ZeroString & CStr(No) & "." & Extension
        No = No + 1
    Loop

    't@Cԋp -----------------------------------------------------------
    GetFileName = WkFileName

End Function
