QueryTableでのテキスト取り込みについて

投稿者 : test_aaa     投稿日時 : 2025/02/13(Thu) 17:25:19     OS : Windows 10     EXCEL : Office 365

---

カンマ区切りで5カラムあるテキストをエクセルに取り込み、
ダブルクォーテーションに囲まれた半角カンマを削除、
ダブルクォーテーションも削除し、新規テキストに保存する処理を想定しています。

データは100万行程度あるため、取り込みはQueryTableの機能を使います。
対象は4ファイルあり、1ファイル目を取り込み、置換、出力、
2ファイル目のシート追加、ファイル取り込み、置換・・・とループさせるのですが、
1ファイル目は問題なく処理できますが、
2ファイル目以降は取り込むと日本語部分が文字化けしてしまいます。

ループ前に何か設定のクリア等が必要でしたらご教示いただきたく存じます。
テキストは日本語を含むUTF-8形式です。

Sub gettxt()

   For i = 1 To 4
   
      'ファイル取り込み
      Worksheets.Add
      ActiveSheet.Name = "Sh" & i
      sh_name = "Sh" & i
      Set wsImport = Worksheets(sh_name)
      FilePath = Application.GetOpenFilename(Title:="ファイル選択")

      Set queryTb = wsImport.QueryTables.Add(Connection:="TEXT;" & FilePath, _
                      Destination:=wsImport.Range("A1"))

         With queryTb
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        '
        .Delete
         End With

         'カンマの置換
         lastrow = Cells(Rows.Count, 1).End(xlUp).Row
         ary = Range(Cells(1, 5), Cells(lastrow, 5)).Value

         l = 0
         For k = 1 To UBound(ary)
            If IsError(ary(k, 1)) = False Then
            Else
               ary(k, 1) = "'" + Cells(k, 5).FormulaR1C1
            End If

            l = InStr(ary(k, 1), ",")
            If l <> 0 Then
               ary(k, 1) = Replace(ary(k, 1), ",", "")
               ary(k, 1) = Replace(ary(k, 1), """", "")
               l = 0
            End If
         Next k

         Range(Cells(1, 5), Cells(lastrow, 5)).ClearContents
         Range(Cells(1, 5), Cells(lastrow, 5)).Value = ary

         --'シートの内容をテキストに保存する処理(省略)

   Next i

End Sub

投稿者 : ピロリ     投稿日時 : 2025/02/14(Fri) 19:19:07

---

■[質問] test_aaaさん（2025-02-13 17:25:19）の記事
＞ 1ファイル目は問題なく処理できますが、
＞ 2ファイル目以降は取り込むと日本語部分が文字化けしてしまいます。
ご提示のコードで、私の環境では 4ファイルとも文字化けしないです。（テストデータは数行程度ですけど）
なので、大したアドバイスはできませんが･･･
①文字化けしているファイルって、UTF-8コード以外（S-JISコードなど）ってことはないですか？
②これは余り効果無さそうですけど → 1ファイル取込むごとに　Set queryTb = Nothing　してみるとか。
③1ファイル目は問題ないってことなら、4回ループは別のメイン処理に任せ、この処理ではループさせないとか。
　要は、メイン処理からこのサブルーチンをコールするってことで、下のような感じですかね。

外していたらご免なさい。

Sub main()
    For i = 1 To 4
        gettxt (i)      '← 取込みサブルーチンをコール
    Next i
End Sub

Sub gettxt(i)           '← i はパラメータ化
    'For i = 1 To 4     '← ループをやめて、
        'ファイル取り込み
        Worksheets.Add
        ActiveSheet.Name = "Sh" & i
        
        '　【 以降のコードは省略 】
        
    'Next i             '← ループはやめる
End Sub

投稿者 : test_aaa     投稿日時 : 2025/02/17(Mon) 12:09:52

---

>ピロリさん
返信ありがとうございます！
②、③を実施しましたが、やはり2ファイル目から文字化けしてしまいました。

①はUTF-8です。
VBA処理外の部分ですが、400万行あるテキストをPowerShellのコマンドで100万行に
分割する手順を先にしています。

上記、モジュールの実行完了後、続けて実行すると、1ファイル目から文字化けするケースもありました。
xlsmファイルを閉じて、開きなおして実行すると、また1ファイル目は正常、2ファイル目から文字化け…という
結果になりました。
私のエクセルの設定？か何かの問題かもしれません。

投稿者 : ピロリ     投稿日時 : 2025/02/17(Mon) 21:37:52

---

■[返信 2] test_aaaさん（2025-02-17 12:09:52）の記事
＞ ②、③を実施しましたが、やはり2ファイル目から文字化けしてしまいました。
＞ ①はUTF-8です。
①～③、外してましたか。　お役に立てずご免なさい。

少し時間ができたので、とりあえず "山田太郎" 程度の日本語ですけど、5フィールド×100万レコードのテキストを
作って試してみましたが、やはり 4ファイルとも文字化けはしないですね･･･
私の環境では再現性もなく、これ以上のアドバイスはできそうも無いので、ここまでとさせていただきます。
申し訳ないですが他の方の回答をお待ち下さい。　良い解決案が有ると良いですが･･･

投稿者 : test_aaa     投稿日時 : 2025/02/20(Thu) 15:12:55

---

VBAの内容は問題なく、取り込むテキストの文字コードの問題かと思います。
問題点が絞れて前進できました。ありがとうございます。