フォルダ 異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Sub ByRefByValSubFunction() '********************************************************************** '異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する '********************************************************************** '《値の受け渡し》ByRefとByValの使い別け '《値の受け渡し》SubとFunctionの比較 '動作：フォルダＡテキストをフォルダＢファイルのフォーマットにして変換 '変換したファイルをフォルダＣへ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 Byte) As 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 String, ByVal 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 |