QA@IT

Excel VBA で CSVデータをADODB.RecordsetにてCopyFromRecordsetするとデータが欠損する

13619 PV

Windows 8.1(64bit) で MS-Office Professional Plus 2010 を使用しています。

CSVファイルのデータをEXCELに読み込む処理を作成しているのですが、
一部の項目が取り込めていないケースがあり、その原因及び回避方法を調査しているのですが、
何かご存知の方いらっしゃらないでしょうか。

CSVファイルには、1レコード内に複数のメモ項目が存在しており、1レコードが複数行にわたるケースが存在します。
例.
rec1:"1","fld2 あああ\n
いいい\n
ううう","fld3","fld4"
rec2:"2","fld2 かかか\n
ききき\n
くくく","fld3","fld4"

エラーとなるサンプルデータを下記にアップロードしています
サンプルデータ (http://firestorage.jp/)

サンプルデータを読み込むと L56~L63,L139~L141,L150~L151 のセルデータが欠損しています。
また、L列以外のデータに欠損は確認できませんでした。

以下、CSV取込のコードです

Public Sub readCsv()
    Dim dstSheet As Worksheet
    Dim objCn As ADODB.Connection
    Dim objRS As ADODB.Recordset

    On Error GoTo eh

    Set dstSheet = ThisWorkbook.Worksheets("Sheet1")
    Set objCn = New ADODB.Connection
    With objCn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Extended Properties") = "Text;HDR=NO"
        .Open "c:\temp\"
    End With

    Set objRS = New ADODB.Recordset
    Set objRS = objCn.Execute("SELECT * FROM data.csv")

    With dstSheet
        .UsedRange.ClearContents
        .Range("A1").CopyFromRecordset objRS
    End With

quit:
    If Not (objCn Is Nothing) Then objCn.Close
    Set objRS = Nothing
    Set objCn = Nothing
    Exit Sub

eh:
    MsgBox Err.Description, vbCritical
    If Not (objCn Is Nothing) Then objCn.Close
    Set objRS = Nothing
    Set objCn = Nothing
End Sub

以上、よろしくお願いします。

  • データありがとうございます。マクロの確認はすぐにはできませんがcsvは取得しました。
    もし何かわかればコメントします。
    -
  • よろしくお願いします。 -

回答

質問から時間が経ちすぎているためかサンプルデータが手に入らなかったので確認はできませんでした。

質問に書いてあるデータを加工して Win7 64bit Office 2010 + ADODB Library 2.8で試してはみましたが普通に読み込めます。
特に改行(\n:0x0a)を含むものが沢山あればいいというわけでもなさそうですね。
(質問にも L列でだけ発生しますとありますのでその辺りはすでにお気づきとは思いますが。)

stackoverflowに似たような質問がありました。
以下ではMySQLデータベースから取得したときに取れていないフィールドがあるというもので、
CopyFromRecordsetを止めて1行1行丁寧に取るようにしたら改善したそうです。

http://stackoverflow.com/questions/10228328/sql-query-doesnt-return-full-results-for-only-one-field

まだ未解決でしたら参考にどうぞ。

編集 履歴 (0)
  • 回答ありがとうございました。 -

回答ありがとうございます。
サンプルのコードを元に、1レコード,1フィールドごとに値をセットする形式に修正してみたのですが、結果は同じでした。

    With dstSheet
        .UsedRange.ClearContents
        .Range("A1").CopyFromRecordset objRS
    End With

修正版

    With dstSheet
        .UsedRange.ClearContents
        iFld = 1
        iRow = 1
        While Not objRS.EOF
            iFld = 1
            For Each objFld In objRS.Fields
                If (iRow = 1) Then
                    .Columns(iFld).NumberFormatLocal = "@"
                End If
                .Cells(iRow, iFld).Value = objFld.Value
                iFld = iFld + 1
            Next
            iRow = iRow + 1
            objRS.MoveNext
        Wend
    End With

エラーデータについては念のため再度アップロードしました。
[サンプルデータ] [http://firestorage.jp/]

 尚、現時点ではCSVファイル EXCEL.Workbooks.OpenText で開き、クリップボード経由で目的のワークシートにデータをセットする形で対応しています。

ただ、

  • メモ項目内の改行が正しく扱えない(メモの改行でレコードが分割される)ため、メモの改行コードを変換して読み込む等の手段が必要。
  • OpenText メソッドの FieldInfo パラメーターを設定しておかないと数値コード項目等が勝手に書式設定されてしまう。

このような問題があったため、思ったより面倒な対応となっています。

編集 履歴 (0)
ウォッチ

この質問への回答やコメントをメールでお知らせします。