Sub inFixedLengthData()
'固定長テキストファイル(全角半角混じり)を正しくテーブルに取り込む
'全角文字の取込み不具合解消版 2011/04/03 pPoy
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim stSQL As String

    Dim myWSH As Object             'WScript
    Dim myDesktopPath As String
    Dim objFSO As Object            'FileSystemObject
    Dim objFileIn As Object         'File
    
    Dim stFileIn As String          'ファイルのフルパス
    Dim stLine As String            '1行分のテキスト
    Dim myTmp As String             '1フィールド分のテキスト
    
    Dim stfld(3) As String          '★1行分の文字列格納用
    Dim fldSize(3) As Integer       '★フィールド毎のサイズ(byte)
    
    Dim maxLEN As Long              '1行の文字数
    Dim startP As Long              '開始位置
    Dim i As Long, j As Long
    
    Const ForReading = 1
    Const txtFileName = "固定長テキストデータ.txt"  '★
    Const tblName = "tbl_Hana2_IN"                  '★
    
    '取り出すデータの各byte数を配列に格納
    fldSize(0) = 10                 '★ID
    fldSize(1) = 20                 '★FileName
    fldSize(2) = 30                 '★myMemo
    fldSize(3) = 10                 '★etc
    
    'デスクトップパス取得
    Set myWSH = CreateObject("WScript.Shell")
    myDesktopPath = myWSH.SpecialFolders("Desktop")
    Set myWSH = Nothing
    
    'テキストファイルのフルパス
    stFileIn = myDesktopPath & "\" & txtFileName
    
    'ファイルの存在確認
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FileExists(stFileIn) Then
        Set objFSO = Nothing
        Exit Sub
    End If
    
    '既存データ削除
    Set cnn = CurrentProject.Connection
    stSQL = "delete from " & tblName & ";"
    cnn.Execute stSQL
    DoEvents
    
    '空のテーブル open
    Set rst = New ADODB.Recordset
    stSQL = "select * from " & tblName & ";"
    rst.Open stSQL, cnn, adOpenKeyset, adLockOptimistic

    '取込み開始
    Set objFileIn = objFSO.OpenTextFile(stFileIn, ForReading)
    Do Until objFileIn.AtEndOfStream
        '1行読み込み
        stLine = objFileIn.Readline
        maxLEN = Len(stLine)                '1行の文字数
        startP = 1                          '読込開始位置
        '行内ループ
        For i = 0 To UBound(fldSize)
            myTmp = ""
            'フィールド内ループ
            For j = startP To maxLEN
                myTmp = myTmp & Mid(stLine, j, 1)
                If lenbt(myTmp) = fldSize(i) Then
                    stfld(i) = myTmp
                    startP = startP + Len(myTmp)
                    myTmp = ""
                    Exit For
                End If
            Next j
        Next i

        'テーブルに格納
        With rst
            .AddNew
            For i = 0 To UBound(stfld)
                rst(i).Value = stfld(i)
            Next i
            .Update
        End With
    Loop

    MsgBox "処理修了！", vbOKOnly
    rst.Close: Set rst = Nothing: Set cnn = Nothing
    Set objFileIn = Nothing: Set objFSO = Nothing
End Sub

1. 取込むデータを変更する場合は、取込み先のテーブル構造の変更と共に、コードの 「★」 マーク部分の変更も必要です。
   
   
2. このコードではテキストデータに項目行が存在しない為、データの最初から最後まで読み込んでいます。
   項目行付きのデータの場合は、項目行をスキップさせる処理が必要です。
   
   
3. 特定の全角文字が含まれるテキストデータをインポートする際桁がずれる不具合は、Access2000 以降の現象です。
   Access2010 になって解消されているかと思っていましたが、ダメでした。 (Windows7+Access2010 でも発生します。)
   ※ この不具合は、Access97 では発生しません。