• ベストアンサー

アクセスにtxtファイルの指定行のみインポートしたい

先ほども、似たような質問をさせて頂いたのですが、おおもととして、質問していた、textファイルのインポート自体は出来るようになりましたので、 質問を絞って再度、ご質問させて下さい。 textファイルをインポートすると、”データ型の変換エラーが発生しました。”と出ます。 それは、textファイルに、他の行とは違う桁数の、余分な行(先頭行と最終行)があるからです。 先に、textファイルを開き、削除して行えば、問題ありませんが 出来れば、何も編集せずにアクセスで、何行目から何行目までを取り込む。と言った物にしたいです。 csvなどは、簡単に設定できるようですが、textも出来るのでしょうか? ちなみに、今の構文を書いておきます。 どちらに、その構文を追加すれば、いいのかまで、教えていただけると大変助かります。 Private Sub コマンド64_Click() Dim strLine As String Dim dbs As Database Dim rst As Recordset Set dbs = CurrentDb Set rst = dbs.OpenRecordset("支払明細") Open CurrentProject.Path & "\支払明細.txt" For Input As #1 Do Until EOF(1) Line Input #1, strLine strLine = StrConv(strLine, vbFromUnicode) With rst .AddNew !旧請求年月日 = StrConv(MidB$(strLine, 14, 6), vbUnicode) !指定伝票番号 = StrConv(MidB$(strLine, 20, 7), vbUnicode) !種類 = StrConv(MidB$(strLine, 64, 8), vbUnicode) !数量 = StrConv(MidB$(strLine, 84, 5), vbUnicode) !単価 = StrConv(MidB$(strLine, 89, 7), vbUnicode) !請求金額 = StrConv(MidB$(strLine, 96, 11), vbUnicode) .Update End With Loop Close #1 rst.Close MsgBox "インポートを終了しました。" End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • chie65536
  • ベストアンサー率41% (2512/6032)
回答No.4

>早速、chie65536さんの書いてくださった構文を追加して実行してみました。 >しかし、何故か、取り込めませんでした。 If MidB$(strLine, 1, 1) = "D" Then を If MidB$(strLine, 1, 1) = StrConv("D",vbFromUnicode) Then か If StrConv(MidB$(strLine, 1, 1),vbUnicode) = StrConv("D",vbUnicode) Then に修正して下さい。 比較式の左辺の文字列が「vbFromUnicode」になっているので右辺も「vbFromUnicode」にする、または、両辺を「vbUnicode」にする、と言う処理を忘れていました。 StrConvした文字列は、「"」で囲った文字列と、文字コード体系が異なるのでした。

d-loop
質問者

お礼

すごいっ!!出来ました!(^^)! 感謝しております。本当にありがとうございました。

その他の回答 (3)

noname#140971
noname#140971
回答No.3

次の FileReadNRow関数で指定行を読み込むことが出来ます。 1,AAAA 2,BBBB 3,CCCC ? FileReadNRow("C:\TEMP\Test.txt", 2) 2,BBBBB Public Function FileReadNRow(ByVal FileName As String, ByVal N As Integer) As String On Error GoTo Err_FileReadNRow   Dim I  As Integer   Dim fso As FileSystemObject   Dim fil As File   Dim txs As TextStream   Dim TEXT As String      Set fso = New FileSystemObject   Set fil = fso.GetFile(FileName)   Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)   For I = 1 To N     TEXT = txs.ReadLine   Next I   FileReadNRow = TEXT Exit_FileReadNRow:   Exit Function Err_FileReadNRow:   Resume Exit_FileReadNRow End Function Microsoft Scripting Runtime を参照する必要があります。 これを、工夫するか、 For I = S To N   strData=FikeReadNRow(I)   ・・・・ NEXT I という風に利用するか・・・。

d-loop
質問者

補足

アドバイスありがとうございます。 しかし、ド素人の私では理解不可能です。 取り込みたい行を1行だけ指定するのではなく、何行から何行と言った風にもできるのでしょうか??

  • chie65536
  • ベストアンサー率41% (2512/6032)
回答No.2

こういうテキストファイルは、たいてい 1桁目が1で始まるスタート行 1桁目が2で始まる明細行の1行目(1ブロック目)  | 1桁目が2で始まる明細行の最終行(1ブロック目) 1桁目が8で始まる合計行(1ブロック目) 1桁目が2で始まる明細行の1行目(2ブロック目)  | 1桁目が2で始まる明細行の最終行(2ブロック目) 1桁目が8で始まる合計行(2ブロック目) 1桁目が9で始まるエンド行 のようになっている筈です。テキストファイルの構造を良く確かめて下さい。 で、1行の中のどこかの桁に「この行は取り込むべき明細行である」と言う目印があった時だけ、データを取り込むように作りましょう。 「明細行は先頭1文字が『2』の時のみ」と仮定した場合、以下のようにif文を追加します。 Do Until EOF(1) Line Input #1, strLine strLine = StrConv(strLine, vbFromUnicode) if MidB$(strLine, 1, 1) = "2" then '先頭1文字が「2」の時のみ明細行 With rst .AddNew !旧請求年月日 = StrConv(MidB$(strLine, 14, 6), vbUnicode) !指定伝票番号 = StrConv(MidB$(strLine, 20, 7), vbUnicode) !種類 = StrConv(MidB$(strLine, 64, 8), vbUnicode) !数量 = StrConv(MidB$(strLine, 84, 5), vbUnicode) !単価 = StrConv(MidB$(strLine, 89, 7), vbUnicode) !請求金額 = StrConv(MidB$(strLine, 96, 11), vbUnicode) .Update End With end if '追加したif文の終り Loop なお「ちゃんと処理する」と言う視点から見ると「テキストファイルに合計行があるなら、読み込んだ明細行の合計と、合計行に書かれた合計が正しいかチェックする」とか「テキストファイルの特定の行の特定の桁に固定の数字や文字が入っているなら、その位置にその固定の数字や文字があるかチェックする」と言う処理も必要です。 こういうチェックをちゃんとしないと 「1万件のデータを読み込ませた後で、全然違う構造の全然違うテキストファイルを間違って読み込ませた事に気が付いた。元のデータは間違って読んだテキストファイルのデータで上書きされて元に戻せない。1万件のデータを伝票から全件手入力するハメに」 「途中で切れたファイルを読みこませたらしく、合計金額が合わないのに誰も気付かない。誰かが気付いた時には全データを全部の伝票と照らし合わせないとならない」 「修正したファイルを読み込ませたつもりが、間違って古いのを読み込ませ、合計金額が合わないのに誰も気付かない。誰かが気付いた時には全データを全部の伝票と照らし合わせないとならない」 なんて事が起きます。 「チェックもしないで、それがそこにある筈」と言う作り方をするのは「アマチュアが家庭で使う自作プログラム」だけにしましょう。

d-loop
質問者

補足

ありがとうございます。 このPGは、私が使用するだけで、元々目視で行っている、チェックにプラスアルファでやろうと思っているだけなので、 chie65536さんの心配して下さっているような事はありません。 これから、もっと勉強して、人にも使って貰えるような物が作れるようになればいいですが。。。 ちょっと私の脳ではついていけない感じです。なんて言っても、ド素人なので^_^; 早速、chie65536さんの書いてくださった構文を追加して実行してみました。 しかし、何故か、取り込めませんでした。 エラーは出ずに、インポート終了しました。と出ました。 インポート先のテーブルがおかしいのでしょうか? 取込たいデータの仕組みは、chie65536さんの言うとおり 見分けがつき、下記のような感じです。 B** *** D********** ******** D********** ******** T** ***** ***** Dで始まる行だけを取込みたいです。 テーブルの、項目は、 ID オートナンバー 旧請求年月日 数値型 指定伝票番号 数値型 種類 テキスト型 数量 数値型 単価 数値型 請求金額 数値型 です。 修正後の構文は Private Sub コマンド64_Click() Dim strLine As String Dim dbs As Database Dim rst As Recordset Set dbs = CurrentDb Set rst = dbs.OpenRecordset("支払明細") Open CurrentProject.Path & "\支払明細.txt" For Input As #1 Do Until EOF(1) Line Input #1, strLine strLine = StrConv(strLine, vbFromUnicode) If MidB$(strLine, 1, 1) = "D" Then With rst .AddNew !旧請求年月日 = StrConv(MidB$(strLine, 14, 6), vbUnicode) !指定伝票番号 = StrConv(MidB$(strLine, 20, 7), vbUnicode) !種類 = StrConv(MidB$(strLine, 64, 8), vbUnicode) !数量 = StrConv(MidB$(strLine, 84, 5), vbUnicode) !単価 = StrConv(MidB$(strLine, 89, 7), vbUnicode) !請求金額 = StrConv(MidB$(strLine, 96, 11), vbUnicode) .Update End With End If Loop Close #1 rst.Close MsgBox "インポートを終了しました。" End Sub です。 お手数ですが、再度、ご教授お願いいたします。

  • Dxak
  • ベストアンサー率34% (510/1465)
回答No.1

> strLine = StrConv(strLine, vbFromUnicode) と > !~ = StrConv(MidB$(strLine, ~, ~), vbUnicode) の部分で、気になってるのですが・・・ ・OSとAccessのバージョンは何ですか? ・「支払明細.txt」の文字コードは何で出力されてきてますか? Accessは、2000以降Unicodeが標準とされ、Windowsは、XP以降(2000も、そうだっけ?)、Unicodeが標準となってます 要するに、最初のvbFromUnicodeでシステム既定の文字(Unicode)に変換してあるのでは?と思ったりしているのですが・・・UnicodeをMIDBで、切れば文字としてしか扱えず、自動的に型の変換が出来なくて、 > ”データ型の変換エラーが発生しました。” が、起こってるのでは?と思ったりしたのですが・・・

d-loop
質問者

補足

アドバイスありがとうございます。 WINDOWS XP のACCESS2003です。 なんせ、素人ですので、文字コードが何で、出力されているのか、わからないのですが 1行目と最終行だけ、データの形式が違うと言うか、空白の数が違い それを、テキストで開いて、先に削除してしまってから、取り込めばうまくいきました。

関連するQ&A

  • AccessでCSVをインポートしたい(VBA)

    お世話になります。AccessVBA暦2週間の初心者です。 AccessでCSVをインポートできたらいいなと思い ↓下のサイトにあるVBAサンプルを参考にして以下のようにプログラミングをしました。 http://memo.bz/access/advance/csvinpsam Public Function SplitTest() On Error GoTo myError Dim dbs As Database Dim rst As Recordset Dim varData As Variant Dim lngFileNum As Long Dim strData As String Dim xSQL As String FileName = TestGetFileName '入力元CSVファイルを開く lngFileNum = FreeFile() Open FileName For Input As #lngFileNum 'テーブルを開く Set dbs = CurrentDb Set rst = dbs.OpenRecordset("Data") 'CSVファイルの全レコードを読み込むループ Do Until EOF(lngFileNum) 'CSVファイルより1件分を読み込み Line Input #lngFileNum, strData 'カンマで区切って配列に代入 varData = Split(strData, ",", , vbTextCompare) '各フィールドデータをテーブルに追加 With rst .AddNew ![Code1] = varData(0) ![Code2] = varData(1) ![TS] = varData(2) ![PM] = varData(3) ![金額] = varData(4) ![摘要] = varData(5) ![メモ] = varData(6) .Update End With Loop rst.Close Close #lngFileNum MsgBox "データの取り込みが終了しました" Exit Function myError: MsgBox "ファイル名を指定してください" End Function 'CSVファイル選択 Function TestGetFileName() 'ファイル選択 Const ENABLE_WIZHOOK = 51488399 Const DISABLE_WIZHOOK = 0 Dim strFile As String Dim intResult As Integer WizHook.Key = ENABLE_WIZHOOK ' WizHook 有効化 intResult = WizHook.GetFileName( _ 0, "", "", "", strFile, "", _ "すべてのファイル (*.*)|*.*", _ 0, 0, 0, True _ ) WizHook.Key = DISABLE_WIZHOOK ' WizHook 無効化 TestGetFileName = strFile End Function ダイアログは普通に開けるのですがインポートが出来ず「ファイル名を指定してください」 というメッセージボックスが出ます。 弄っている部分は ![フィールド1] = varData(0)を ![Code1] = varData(0)にしているぐらいです。 何が悪いのか皆目見当がつきません。 こんな初心者でございますがご教授のほどよろしくお願いします。 (ヒントでも構いません) 説明不足等ございましたらご指摘のほどよろしくお願いします。

  • アクセス2000(ADO)のレコード更新について

    1件しかレコードがない[リスト連番T]テーブルのレコードを読みだして、(フィールド)リストNOをプラス1して更新したいです。 DOAが混ざっているのか、下記のようにエラーがでます。プラス1して更新する正しいプログラムを教えて下さい。 Private Sub リスト_Click() Dim DBS As Databasu Dim CNC As New ADODB.Connection Dim RST As New ADODB.Recordset Dim LISTNO As Intejer Set CNC = CurrentProject.Connection RST.Open "リスト連番T", CNC, adOpenKeyset,adLockOptimistic, adCmdTableDirect LISTNO = RST!リストNO RST.Close Set RST = Nothing CNC.Close Set CNC = Nothing Set DBS = CurrentDb Set RST = DBS.OpenRecordset("リスト連番T") With RST -----.Edit で コンパイルエラー-----   メソッドまたはデータメンバーがみつかりません .Edit !リストNO = LISTNO + 1 .Update .Close

  • アクセス2000VBA DAOをADOに書き換えてください

    アクセス2000VBA DAOをADOに書き換えてください 下記プログラムをADOに書き換えてください。(DAT1、DAT2はモジュールにて定義してあります) Option Compare Database Dim DBS As Database Dim QDF As QueryDef Dim RST As DAO.Recordset Dim COUNT1 Private Sub Form_Load() On Error Resume Next DAT2 = [Forms]![伝票]![HAKKOU1] Set DBS = CurrentDb Set QDF = DBS.QueryDefs("発行") With QDF .Parameters("DAT1") = DAT2 ’もしかしたら DAT2 ではエラーがでるかもしれません。 Set RST = .OpenRecordset() ’正しい記述を教えてください .Close End With With RST COUNT1 = !指示書 .Close End With

  • Access2007 データ型エラーについて

    お世話になっております。 下記のVBAでコードを数値型からテキスト型に変更したところ、「抽出条件でデータ型が一致しません。」というエラーが出ました。 デバッグをクリックすると、dbs.Execute strSQLの部分が黄色に反転しています。 VBAはあまり詳しくありませんので、エラーが出なくなる方法を教えていただければ助かります。 よろしくお願いいたします。 Private Sub 在庫差引_Click() Dim dbs As Database Dim rst As Recordset Dim strSQL As String Set dbs = CurrentDb Set rst = Me!サブフォーム.Form.RecordsetClone With rst .MoveFirst Do Until .EOF strSQL = "UPDATE マスター " & _ "SET 在庫数 = NZ(在庫数) - " & Nz(!数量, 0) & " " & _ "WHERE コード = " & !コード dbs.Execute strSQL .MoveNext Loop .Close End With End Sub

  • CSVの出力(1行を3行に出力~)

    テキスト式1行 200705 00001 A01 A02 B01 B02 C01 C02があるとします。 200705と00001は3行の先頭を出したいので、どうやってループさせたらいいのかわからないのです。 今の状況 Private Sub Object(lFname As String, lOFilename As String) Dim IUO As Variant ''出力データ Dim lFBnt As Long ''開始位置1 Dim m_Input As String ''レコード退避先データ Dim byteInput() As Byte ''領域確保変数 Dim fs As Object ''ファイルシステムオブジェクト Dim ObjOutFile As Object ''出力先ファイルオブジェクト'' IUO = "" ''出力先ファイルオブジェクトの作成 Set fs = CreateObject("Scripting.FileSystemObject") ''出力先ファイル名の指定 Set ObjOutFile = fs.CreateTextFile(lOFilename, True) ReDim byteInput(レコードの長さ- 1) ''正常ファイル時のファイルオープン Open lFname For Binary As #1 '' ファイルの終端までループを繰り返します。 Do While Loc(1) < LOF(1) IUO= "" ''該当行のレコードデータの取得 Get #1, , byteInput m_Input = StrConv(byteInput, vbUnicode) lFBnt = 1 IUO = IUO + Chr(39) & MidMbcs(m_InputBuffer, lFBnt, 一つ目のパラメータ名) + Chr(39) lFBnt = lFBnt + 一つ目のパラメータ名 IUO = IUO + vbNewLine ''改行 ''ファイルへの書込 ObjOutFile.Write (IUO) Me.Refresh Loop Close #1 ''File close ObjOutFile.Close Set ObjOutFile = Nothing End Sub 以上では1行しか出力できないのですが、どうやったら3行出力できるのでしょうか。 よろしくおねがいします。

  • ACCESS97 : レコードが長いファイルのインポートについて

    ACCESS97で、文字列を文字数ではなくバイト数で扱うことは可能でしょうか。 1レコードが20,000ByteあるテキストファイルをACCESS97のテーブルに インポートしようとしています。 インポート先のテーブルのフィールドをすべて「メモ型」にしたのですが、 インポート定義を利用してインポートを行おうとすると、 「レコードが大きすぎます。」というエラーが発生します。 そこで、プログラムでファイルを1レコードずつ読み込みながらテーブルに インサートしていく方法を取ろうかと思います。 テキストファイルは半角と全角が混在しているのですが、困ったことに 全角のデータが入るべきところに半角が混ざっている可能性があります。 たとえば、全角10文字入るべき場所に半角の空白が20文字入っていると いうような状態です。 この状態で StrConv関数でUnicodeに変換してからMidB$関数で文字を抜き 出すと、フィールドがずれてきます。 1文字目から10文字分、ではなく1Byte目から10Byte、などというように文 字列を扱うことができれば、全角と半角がどのような位置で混在していても 関係なくプログラム上で扱うことができると思うのですが,方法がわかりません。 また、これ以外で長いレコードのファイルをインポートできる方法があれば 教えていただきたいと思います。 長くなってしまいましたが、ご回答をいただけますようよろしくお願いいたします。

  • Access2010 「型が一致しません。」エラー

    お世話になっております。 テキストファイルからデータを取り込んで、テーブルにあるデータと同じデータのみを表示させるプログラムがあります。 コードが「001」のように整数の場合は問題ないのですが、「A001」のように英数のデータの場合は、このエラーが出てしまいます。 「実行時エラー13 型が一致しません。」 デバッグをクリックすると、下記の部分が黄色に反転します。 「If DFirst("コード", "テーブル", "コード = '" & avarFldData(0) & "'") Then」 テキストファイルのデータがテーブルにない場合はエラーが出ませんので、一致したデータがある場合のみエラーが出ます。 VBAはあまり詳しくありませんので、エラーが出なくなる方法を教えていただければ助かります。 よろしくお願いいたします。 Private Sub Form_Load() Dim dbs As Database Dim rst As Recordset Dim strImportDir As String Dim strFile As String Dim lngFileNum As Long Dim strData As String Dim avarFldData As Variant Dim iintLoop As Integer DoCmd.Hourglass True strImportDir = Application.CurrentProject.Path & "\" strFile = strImportDir & "File.TXT" Set dbs = CurrentDb GoSub ReadFile Me.Requery DoCmd.Hourglass False Exit Sub ReadFile: Set rst = dbs.OpenRecordset("履歴", dbOpenDynaset, dbAppendOnly) lngFileNum = FreeFile() Open strFile For Input As #lngFileNum Do Until EOF(lngFileNum) Line Input #lngFileNum, strData avarFldData = Split(strData, ",", , vbTextCompare) For iintLoop = 0 To UBound(avarFldData) avarFldData(iintLoop) = Trim$(avarFldData(iintLoop)) Next iintLoop If DFirst("コード", "テーブル", "コード = '" & avarFldData(0) & "'") Then With rst .AddNew !コード = avarFldData(0) .Update End With End If ' End If Loop Close #lngFileNum rst.Close Kill strFile Return End Sub

  • ACCESS2000VBAでエラー「型が一致しません」

    ACCESS2000で、フォーム上にボタンを作り、そのボタンをクリック時に 以下のイベント プロシージャを実行させています。 Dim dbs As Database Dim rst As Recordset Set dbs = CurrentDb Set rst = dbs.OpenRecordset("採番_相談者") Dim Number rst.MoveFirst Number = rst!相談者番号 Number = Number + 1 Me.相談者NO = Number '相談者NOはフォーム上のテキストボックスです。 で上記 Set rst = dbs.OpenRecordset("採番_相談者") の所で、「実行時エラー 13 型が一致しません」とエラーになります。 テーブル:採番_相談者は、オートナンバー型のIDフィールドと相談者番号という7桁のテキスト型で ”1000001”が入っています。(ちなみに、数値型に変えても同じエラーでした。) 詳しい方教えてください。お願いします。

  • エクセルに二つのテキストファイルをインポートしたい

    エクセルのsheet1の1行目にタイトルがあります。 ボタンのクリックイベントで、テキストファイル2つをインポートしたいのですが。 ・テキストファイルの名前は、固定ではありません ・テキストファイルの保存先は、デスクトップで、ファイルの選択は自分でしたい ・テキストファイルの一行目は、タイトル行なので、二行目以降をインポートしたい 行数は固定ではありません ・タブ区切りです 複数選択はできなく、1ファイルでタイトル行も含めるのであれば下記コードできたのですが。 どなたか、ご教示いただけますでしょうか・・・・ よろしくお願いいたします。 ----------------------------------------------------- Sub ReadTextFile() 'タブ区切りファイルを全て文字列として読み込む Dim FileName As String Dim i As Long Dim Cnt As Long Dim Buf As Variant Dim FileNo As Integer Dim SplitString As Variant 'ファイルダイアログを表示 FileName = Application.GetOpenFilename("テキストファイル,*.txt") If FileName <> "False" Then '全セル選択して書式を文字列にセットする Cells.Select Selection.NumberFormatLocal = "@" Cells(1, 6).Select '空いているファイル番号を取得 FileNo = FreeFile() Buf = Space(FileLen(FileName)) 'ファイルを開いてbufに1行読み込み ' → タブで配列に分割 ' → セルに書き出し Open FileName For Input As #FileNo Do Until EOF(FileNo) Line Input #FileNo, Buf Cnt = Cnt + 1 SplitString = Split(Buf, vbTab) For i = 0 To UBound(SplitString) Cells(Cnt, i + 1) = SplitString(i) Next i Loop Close #FileNo Else End If End Sub -----------------------------------------------------

  • access2000VBAで、外部ファイルに書き込むには

    access2000 VBAで 「sample.htmlを作成、 tableテーブルのデータを書き込む」 をして、htmlファイルを自動作成したいのですが、 うまくVBAがかけません。 とりあえず、外部ファイルにデータを出力に取り組んでいます 外部ファイルの作成の仕方と、書き込みのところで、 どうしたらいいのか分からず、困っています。 アドバイスおねがいします。<(_ _)> Dim cnc As New ADODB.Connection Dim rst As New ADODB.Recordset Set cnc = CurrentProject.Connection rst.Open "table", cnc, adOpenKeyset, adLockOptimistic, adCmdTableDirect Open sample.html For Output As #1 If rst.EOF Then MsgBox "There are not recordset" GoTo db_Close End If Do Until rst.EOF Debug.Print rst!種類, rst!名前, rst!url Write #1, rst!種類, rst!名前, rst!url rst.MoveNext Loop Close #1 db_Close: rst.Close Set rst = Nothing cnc.Close Set cnc = Nothing End Sub

専門家に質問してみよう