フォルダ 異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][フォルダ 異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する]
Option Explicit


Sub ByRefByValSubFunction()
'**********************************************************************
'異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する
'**********************************************************************
'《値の受け渡し》ByRefとByValの使い別け
'《値の受け渡し》SubとFunctionの比較
'動作:フォルダAテキストをフォルダBファイルのフォーマットにして変換
'変換したファイルをフォルダCへHTML形式にして作成

Dim strThePath As String
Dim strTheTxtPath As String
Dim AddFilePath As String
Dim Strsend As String
Dim FileName() As String
Dim TXt(20) As String, cntFile As Long, Basictxt(6) As String
Dim AddTxt As String, temporaryTXT As String, cntBasictxt As Long
Dim SearchLetter As String, FolName As String
Dim strFileName() As String
Dim i As Long, lngMin As Long, lngMax As Long
Dim n As Long, buf As Variant, tmp As String
Dim j As Long, strTXT() As String, cntLowTXT As Long

'パラメータ
'フォルダ名
FolName = "index"
'置換するファイルパス
strThePath = ThisWorkbook.Path & "\" & FolName & "\"
'検索するファイルパス
strTheTxtPath = ThisWorkbook.Path & "\" & FolName & "Basic\"
'作成するファイルパス
AddFilePath = ThisWorkbook.Path & "\www\xxxx\"
'検索するファイル番号
cntBasictxt = 5
'検索する文字列
SearchLetter = "vbvalue0"
'置換するファイル読み込み最高行
cntLowTXT = 10
'**************************************************
'【置換するファイル】

'ByRefとByValで値の受け渡しをしています。
Call FileNameEnumeration(strFileName, strThePath)

'受け取った変数の最低値と最高値を取得
lngMin = LBound(strFileName)
lngMax = UBound(strFileName)

'各ファイル名を変数格納
ReDim FileName(lngMax) As String
ReDim strTXT(lngMax, cntLowTXT) As String

For i = lngMin To lngMax

    n = FreeFile
    Open strThePath & strFileName(i) For Input As #n
        FileName(i) = Mid(strFileName(i), 1, InStrRev(strFileName(i), ".") - 1)
        j = 0
        Do Until EOF(1) 'EOF 関数
            Line Input #n, tmp
            '各ファイルを行毎に変数格納
            strTXT(i, j) = tmp
            j = j + 1
        Loop
    Close #n

Next i

'EOF 関数
'ランダム アクセス モード (Random) またはシーケンシャル入力モード (Input) で
'開いたファイルの現在位置がファイルの末尾に達している場合、
'ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。

'**************************************************
'【検索するファイル】

For i = 1 To cntBasictxt
    Basictxt(i) = Read_Basic(strTheTxtPath, CByte(i))
Next i

For cntFile = lngMin To lngMax
    AddTxt = ""
    temporaryTXT = ""
        temporaryTXT = Basictxt(1)

        temporaryTXT = Replace(temporaryTXT, SearchLetter & "1", FolName)
        temporaryTXT = Replace(temporaryTXT, SearchLetter & "2", strTXT(cntFile, 0))

        For n = 1 To UBound(strTXT, 2)
            If Left(strTXT(cntFile, n), 1) = 1 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(2), SearchLetter & "3", strTXT(cntFile, n))
            ElseIf Left(strTXT(cntFile, n), 1) = 2 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(3), SearchLetter & "4", strTXT(cntFile, n))
            ElseIf Left(strTXT(cntFile, n), 1) = 3 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(4), SearchLetter & "5", strTXT(cntFile, n))
            End If
        Next n

        AddTxt = temporaryTXT & Basictxt(5)

'生成
TXT_Write AddFilePath & FileName(cntFile) & ".html", AddTxt

Next cntFile
End Sub


Private Function Read_Basic(TxtPath As String, strNo As ByteAs String
'*******************************************************************************
'ファイルを読みこむ
'*******************************************************************************
    Dim n As Long, buf As String, strPath As String
    strPath = TxtPath & strNo & ".txt"
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    buf = Space(FileLen(strPath))
    Open strPath For Binary As #n 'binaryモードで開いたファイル
        Get #n, , buf
    Close #n
    Read_Basic = buf
End Function


Private Sub FileNameEnumeration(ByRef strFileName() As StringByVal strPath As String)
'***********************************************
'指定フォルダ内のファイル名一覧を取得列挙する。
'***********************************************
'呼び出される側
'可変変数

'Dim strPth As String
Dim buf As String, i As Long
Dim strExtension As String

'strPath = strThePath
strExtension = "txt" '拡張子
i = 0

    buf = Dir(strPath & "\*." & strExtension)
    Do While buf <> ""
    ReDim Preserve strFileName(i) As String
        strFileName(i) = buf
        i = i + 1
        buf = Dir()
    Loop

End Sub


Private Sub TXT_Write(FileName As String, str As String)
'*******************************************************************************
'指定パスのテキストファイルに書き込み
'*******************************************************************************
    Dim n As Long
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    Open FileName For Output As #n
        Print #n, str
    Close #n

' キーワード 処理             モード
' Input   読み込み           入力モード
' Output  書き込み           出力モード
' Append  書き込み           追加モード
' Random  読み込み/書き込み  ランダムアクセスモード(データベースのデータファイルにアクセスするモード)
' Binary  読み込み/書き込み  バイナリモード(ファイルのデータを一気に読み込む)

End Sub





Production Japan Import Application. Since 1998