Excelインポート時に255文字を超える文字列が切れる問題

1セルに255文字を超える長いテキストが入力されたExcelファイルをAccessにインポートする時、【長い文字列型】フィールドなのに、255文字を超える部分が切り落とされてインポートされてしまう現象の、原因と対処方法、実際のVBAコード例を掲載しています。

文字切れが起こる原因

例え話にすると「Excelデータ」が「Accessレコード」の世界に転生するにあたっては、審査をする門番が2人います。その1人目がせっかちで誤判定しがちで、Accessさんもその判定を盲信してしまうからです。

◆第一関門：スキャンの門番
まず最初に、インポートするExcelシートの先頭レコード8行だけがスキャンされ、その内容に基づいて各列のデータ型が判定されます。(その時、受け入れ側のテーブル定義は考慮されません。)

たまたま冒頭の8行に255文字超のセルが含まれておらず、数値や日付でもないフィールドは「【短いテキスト型】でオッケー！」と判定されて、次の関門へ送られてしまいます。
（逆に、たまたま冒頭8行に255文字を超えるテキストが含まれていたフィールドは【長い文字列型】判定を獲得できます。)

8行スキャンについてはMicrosoftのサポートサイトをご確認ください

◆第二関門：テーブル定義の門番
次に、スキャンの門番から申し送りされてきた判定結果と、テーブル定義の間に齟齬がないかの判定が行われます。日付型にテキスト型のデータを入れようとするなど、フィールド定義と不一致なデータをインポートをしようとすれば、この門番のNG発動によりエラー発生となります。

ところが、【短いテキスト型】のデータを【長いテキスト型】のフィールドへインポートするのは、大は小を兼ねるので問題は無く、エラーにはなりません。

◆転生(インポート)受け入れ：Accessさま
そして第二関門通過後は、スキャンの門番が【短いテキスト型】と申し送りして来たのだから、そのつもりでしかAccessさまは読み取らないのです。
「テーブル定義が【長い文字列型】なんだから、長い文字列として読み取とろう」とはしてくれないのです。かくして文字切れインポートが発生することとなります。

対処方法

要は「冒頭8行以内に255文字超のテキストが入力されているレコードがあれば良い」わけなので、事前にExcelファイルをVBAで編集し、255超の文字列が入力されているダミーレコードを先頭行に挿入追加してからインポートすれば、文字切れを防止できます。

サンプルプログラムの概要

1. ユーザーが選択したフォルダ内にあるすべてのExcelファイルに対し、以下の処理を行う
2. Excelファイルを読み取り専用で開き、ヘッダーの下に1行挿入する。
3. Access内に保存しておいたダミーレコードを、挿入した空白行へ貼付する。
4. 一時ファイルとしてExcelを別名保存する。
5. 一時ファイルをインポートしてから消去する。
6. 全ファイルのインポート完了後、削除クエリでダミーレコードを削除する。

事前準備

インポート先のテーブルにある、全ての長いテキスト型フィールドの「書式」プロパティを確認、修正する

インポート先のテーブルをコピーして、ダミーレコード用のテーブルを作成する

ダミーレコードを1件だけ手入力する

ダミーレコードだけを削除するための、削除クエリを作成する

サンプルコード

Sub 長い文字列を切らずにインポート()

Dim Tbl_Name As String      'データをインポートするテーブル名
Dim Tbl_DmyR  As String     'ダミーレコードが格納されているテーブル名

Dim QName_DltAll As String  'インポート先テーブルの全レコード削除クエリ名
Dim QName_DltDmy As String  'ダミーレコード削除クエリ名

Dim Tgt_ST  As String       'インポート対象のシート名
Dim Tgt_RG  As String       'インポート対象のセル範囲指定

Dim Q As Long
Dim FD As FileDialog
Dim Fldr_Name  As String    'ユーザーに選択させたフォルダ名
Dim File_Name  As String
Dim File_Cnt As Long

Dim EX As Excel.Application
Dim BK As Excel.Workbook
Dim ST As Excel.Worksheet

Dim DB As DAO.Database
Dim RS As DAO.Recordset

'◆必要情報をセット(↓お手元のツールに合わせて書換えて下さい)
Tbl_Name = "T_Data"     'インポート先テーブル名
Tbl_DmyR = "T_DmyR"     'ダミーレコードのテーブル名
QName_DltAll = "削除Q_T_Data"   'インポート先テーブルの全レコード削除クエリ名
QName_DltDmy = "削除Q_ダミーレコード" 'ダミーレコード削除クエリ名
Tgt_ST = "Data"  'インポート対象のシート名
Tgt_RG = "A1:F" 'インポート対象のセル範囲指定

'◆ユーザーに実行意思を確認
Q = MsgBox("データインポートを実施しますか？", _
            vbYesNo + vbQuestion, "＜確認＞")
    If Q = vbNo Then
        MsgBox "キャンセルされました。"
        Exit Sub
    End If

'◆ユーザーによるフォルダ選択
Set FD = FileDialog(msoFileDialogFolderPicker)
    With FD
        .InitialFileName = CurrentProject.Path
        .Title = "フォルダを指定してください"
        .ButtonName = "決定"
        
        If .Show Then
            Fldr_Name = .SelectedItems(1)
        Else
            MsgBox "フォルダ選択がキャンセルされました。終了します。"
            Exit Sub
        End If
    End With
    
'◆Excelの存在有無チェック
File_Name = Dir(Fldr_Name & "\*xls*")
If File_Name = "" Then
    MsgBox "指定フォルダ内にExcelファイルが格納されていません！", _
           vbExclamation
    Exit Sub
End If

'◆インポート先テーブルをクリア
DoCmd.SetWarnings False
    DoCmd.OpenQuery QName_DltAll
DoCmd.SetWarnings True

'◆ダミーレコード用オブジェクト立ち上げ
Set DB = CurrentDb

'◆新規Excel立ち上げ(非表示)
Set EX = New Excel.Application
    EX.Visible = False

'◆ループ処理開始
Do While File_Name <> ""

    '◆読み取り専用でExcelファイルを開き、シートを取得
    Set BK = EX.Workbooks.Open(FileName:=Fldr_Name & "\" & File_Name, _
                               ReadOnly:=True)
    Set ST = BK.Worksheets(Tgt_ST)
    
    '◆1行目ヘッダーの下に行挿入し、ダミーレコードを貼付
    Set RS = DB.OpenRecordset(Tbl_DmyR)
    
    ST.Rows("2:2").Insert Shift:=xlDown, _
                          CopyOrigin:=xlFormatFromLeftOrAbove
        ST.Range("A2").CopyFromRecordset RS
        
    RS.Close
    
    '◆Accessと同階層にExcelファイルを別名保存する
    BK.SaveAs CurrentProject.Path & "\インポート用一時ファイル.xlsx"
    BK.Close
    
    '◆一時ファイルをインポート
    DoCmd.TransferSpreadsheet acImport, _
    acSpreadsheetTypeExcel12Xml, Tbl_Name, _
    CurrentProject.Path & "\インポート用一時ファイル.xlsx", _
    True, Tgt_ST & "!" & Tgt_RG

    
    '◆一時ファイルを削除し、ファイル数を数えて、再Dir
    Kill CurrentProject.Path & "\インポート用一時ファイル.xlsx"
    File_Cnt = File_Cnt + 1
    File_Name = Dir()
Loop

'◆オブジェクトを閉じる
Set BK = Nothing
EX.Quit
Set EX = Nothing
Set RS = Nothing
DB.Close
Set DB = Nothing

'◆ダミーレコードを削除
DoCmd.SetWarnings False
    DoCmd.OpenQuery QName_DltDmy
DoCmd.SetWarnings True

'◆終了メッセージ
MsgBox "データのインポートが完了しました。" & vbCrLf & _
       "ファイル数：" & File_Cnt, vbInformation

End Sub