'------------------------------------------------------------------------------
'QRコード情報テキスト出力スクリプト
'                                                              TechnoStyle,inc.
'
'テキストファイルにQRコードの内容を出力します。
'1文書1ファイルで出力します。名前付きデータをカンマ区切りで以下のように出力しま
'す。
'注文番号,商品名,数量,金額
'
'出力場所は、以下のスクリプトの「Const WriteFolderName = "C:\Test\データ\"」の
'場所に出力されます。変更したい場合はパスを書き換えてください。
'
'ファイルは、「注文番号.txt」で出力します。同名のファイルが存在した場合は、
'「注文番号_0001.txt」のように連番を付加したファイル名とします。
'------------------------------------------------------------------------------
Option Explicit

Const WriteFolderName = "C:\Test\データ\"
Const ForReading = 1, ForWriting = 2, ForAppending = 8

Call Main

'------------------------------------------------------------------------------
'メイン処理
'------------------------------------------------------------------------------
Sub Main

    Dim fs
    Dim wfile

    'QRコードが一つもなかった場合は終了 ---------------------------------------
    If "{%SYNBOL_COUNT(QRコード読み取り1)}" = "0" Then
        Exit Sub
    End If

    Set fs = CreateObject("Scripting.FileSystemObject")

    '注文番号をファイル名にして保存 -------------------------------------------
    Set wfile = Fs.CreateTextFile(GetFileName(WriteFolderName & _
                      "{%N_DATA(QRコード読み取り1.注文番号)}" & ".txt"), True)

    'カンマ区切りでデータを出力 -----------------------------------------------
    wfile.WriteLine "{%N_DATA(QRコード読み取り1.注文番号)}" & "," & _
                    "{%N_DATA(QRコード読み取り1.商品名)}" & "," & _
                    "{%N_DATA(QRコード読み取り1.数量)}" & "," & _
                    "{%N_DATA(QRコード読み取り1.金額)}"

    wfile.Close

End Sub

'------------------------------------------------------------------------------
'機能       ファイルの存在チェックを行い、ファイルが存在する場合はファイル名の
'           後ろに連番を付加し重複しないファイル名を作成し返却する。
'引数       vFileName   ファイル名
'戻り値     重複しないファイル名
'------------------------------------------------------------------------------
Function GetFileName(vFileName)

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

    'ファイル名の拡張子を取得 -------------------------------------------------
    ItemArray = Split(vFileName,".")
    Extension = ItemArray(UBound(ItemArray))

    'ファイル名の拡張子の前のパスを取得 ---------------------------------------
    FileName = Left(vFileName, Len(vFileName) - (Len(Extension) + 1))

    No = 1
    WkFileName = vFileName

    Set fso = CreateObject("Scripting.FileSystemObject")

    'ファイルの存在チェック ---------------------------------------------------
    Do Until Not (fso.FileExists(WkFileName)) 

        'ゼロパティングの処理 -------------------------------------------------
        If Len(CStr(No)) < 4 Then
            ZeroString = String(4 - Len(CStr(No)),"0")
        Else
            ZeroString = ""
        End If

        'ファイル名に番号を付加 -----------------------------------------------
        WkFileName = FileName & "_" & ZeroString & CStr(No) & "." & Extension
        No = No + 1
    Loop

    'ファイルを返却 -----------------------------------------------------------
    GetFileName = WkFileName

End Function