文字化けするCSVファイル読み込みについて

いつもお世話になっております。
前回、文字化けするCSVファイルをVBAで読み込みしたいと思い質問させていただきました。
（https://oshiete.goo.ne.jp/qa/10978574.html）
ご教示いただいたコードでCSVデータの最初の一行は文字化けせずに内容が表示されたのですが
二行目以降が表示がされません。
ちなみに文字化けしていないCSVで試してみたところ、データは全て表示されました。
自分でも原因を探してみたのですが分からず、アドバイスいただけたらと思います。
よろしくお願いします。

・使用os　excel2016
・表示させたいcsvデータ
→1行目から最終行までを別ブックの("Sheet1")の2行目から表示させたい。

Private Sub CSVConverter(ByVal Fname As String)
　Dim Strm As Object
　Dim i As Long, j As Long
　Dim buf As Variant
　Dim sh As Worksheet
　Dim Lastrow As Long
　Set Strm = CreateObject("ADODB.Stream")
　Set sh = Worksheets("Sheet1")　　'出力シート
　i = sh.Cells(Rows.Count, 1).End(xlUp).Row '行の最後
　With Strm
　　.Charset = "UTF-8" 'Encording
　　.Open
　　.LoadFromFile Fname
　　Do Until .EOS
　　　buf = .ReadText(-2)
　　　buf = Replace(buf, """", "")
　　　arg = Split(buf, ",")
　　　i = i + 1
　　　For j = 0 To UBound(arg)
　　　　sh.Cells(i, j + 1) = arg(j)
　　　Next j
　　Loop
　　.Close
　End With
End Sub

質問者からの補足コメント

• 

  WindFaller様
  前回に引き続き今回もありがとうございます。
  コードも提示してくださり本当に感謝です。
  ただ、やはり２行目以降が表示されず
  特にエラー表示されませんでした。。。

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/02/18 08:20

No.1 回答者： WindFaller 回答日時： 2019/02/17 20:21

前回の回答者です。

もともと、質問者さんが持ってきたコードで加工したわけで、Office Tanaka氏の書いたものを信頼して出来たものだろうと思います。

違う種類のエンコードが混じりこんでいる可能性を私は示唆していましたが、慣れないとそれを調べることは困難なのかもしれません。BOM, BOMなしを試してみましたが、問題は出ませんでした。以下は、私が現在使っているコードを改変したものです。

2種類のマクロを作り、とりあえず、前回の修正部分というか、ノーマル（と思う)ものを掲示します。 TextImportQ(Fname, sh1, sh1.Cells(LastRow, 1)) の方は、現在公開していません。それが駄目だったら、別のものを公開します。
エラートラップ(Err.Number)を入れましたので、エラーが出たら、その番号を教えてください。

なお、なぜ分散型で書くか、ということを思う人がいるかもしれませんが、パーツごとに、再利用しやすいからです。

'//標準モジュール
Sub CSVImportCSV()
　Dim Fname As String
　Dim i As Long, j As Long
　Dim myPath As String
　Dim LastRow As Long
　Dim sh1 As Worksheet
　Dim buf As Variant, arBuf As Variant
　On Error GoTo ErrHandler
　Set sh1 = Worksheets("Sheet1")
　sh1.UsedRange.Clear
　myPath = ThisWorkbook.Path & "\"
　With Worksheets("ファイル名")
　　For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　LastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　Fname = myPath & .Cells(i, 1).Value
　　　If Dir(Fname, vbNormal) <> "" Then
　　　　buf = ConvertCSV2(Fname)
　　　　arBuf = Split(buf, vbCrLf) '状況によっては、vbLfを使う
　　　　Call DataOut(arBuf, sh1, LastRow)
　　　 ' Call TextImportQ(Fname, sh1, sh1.Cells(LastRow, 1))
　　　Else
　　　　.Cells(i, 2).Value = "missing"
　　　End If
　　Next i
　End With
ErrHandler:
　 If Err() <> 0 Then
　　MsgBox Err.Number & ": " & Err.Description
　 End If
End Sub
Private Sub DataOut(arBuf As Variant, mSheet As Worksheet, LastRow As Long)
　Dim buf As Variant, arDat As Variant
　Dim i As Long, j As Long, a As Variant
　With mSheet
　　For i = 0 To UBound(arBuf)
　　　buf = arBuf(i)
　　　arDat = Split(buf, ",")
　　　For j = 1 To UBound(arDat)
　　　　a = Replace(arDat(j - 1), """", "")
　　　　.Cells(i + LastRow, j).Value = a
　　　Next
　　　a = "": buf = ""
　　Next
　End With
End Sub

Private Function ConvertCSV2(ByVal Fname As String)
Dim Strm As Object 'ADODB.Stream
On Error GoTo ErrHandler
Set Strm = CreateObject("ADODB.Stream")
With Strm
.Charset = "UTF-8"
.Type = 2
.Open
.LoadFromFile Fname
ConvertCSV2 = .ReadText
.Close
End With
Exit Function
ErrHandler:
ConvertCSV2 = "err"
End Function

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2019/02/18 09:52

>ただ、やはり２行目以降が表示されず

>特にエラー表示されませんでした。。。

VBAのエラーが発生しないなら、それは、データの終了コードが入っているのでは？
別のコードも用意していましたが、原因が特定できなければ、これ以上、こちらでコードをアップしても無駄だと思います。

それと、その出力のアプリは何でしょうか。以前、POSシステムからの出力ということもありました。本当に、CSVのテキストファイルなのでしょうか。見かけはそっくりの、バイナリで出来たデータファイルもあります。Excelでやり方だけは知っていますが、私は、掲示板上では1度も成功したことがありません。なぜかというと、そのファイルは入手出来ないからです。別の区切り信号が入っているからです。ただ、もともとExcelではサポート外でインポートするようには出来ていないのです。

何度も掲示していれば、いつかは解決するかもしれませんが、現状のこちらのやり取りでは解決はしないでしょう。一応メモ帳レベルよりも上級のエディタで開くなり、バイナリエディタで開いてみたらいかがですか？(FavBinEdit-今回使用したもの)

それから、Excelではなく、EmEditor やCSVを建前とするツールで試してみるのもよいと思います。

画像をつけましたが、標準的なUTF-8 のバイナリの内容です。

念の為、不要のバイナリコードを抜くためのコードです。ただ、解決は難しいと思います。

Private Sub DataOut(arBuf As Variant, mSheet As Worksheet, LastRow As Long)
　Dim buf As Variant, arDat As Variant
　Dim i As Long, j As Long, a As Variant
　With mSheet
　　For i = 0 To UBound(arBuf)
　　　buf = arBuf(i)
　　　buf = Application.Clean(buf)
　　　arDat = Split(buf, ",")
　　　For j = 1 To UBound(arDat)
　　　　a = Replace(arDat(j - 1), """", "")
　　　　.Cells(i + LastRow, j).Value = a
　　　Next
　　　a = "": buf = ""
　　Next
　End With
End Sub

以下は、UTF-8のファイルの中身。この二種類のUTF-8をサポートしますが、先頭のBOMとCRLF(0D0A)以外のバイナリコードは、入れられません。

この回答へのお礼

WindFaller様
何度もありがとうございました。
やはり読み込むためのファイルに問題があるようですが
渡されたデータなのでアプリの確定もできず諦めるしかないようです。

ただ、今回とても勉強をさせていただきました。
今後も機会があれば利用させていただきたいと思いますし
本当にありがとうございました！感謝します！

お礼日時：2019/02/18 21:25