VBAでCSVを読み込みテーブルに追加する際、日付型にする方法

このQ&Aのポイント
  • ACCESS2003を使用している場合、VBAからCSVを読み込みテーブルに追加する際、日付型にしたいです。現在、納入日がテキスト型となっていますが、実行時にエラーが発生します。
  • 納入日を8桁表記のテキスト型にすることで、エラーを回避することができますが、データベースの仕様上、納入日を日付/時刻型にする必要があります。
  • どのようにすれば、VBAからCSVを読み込みテーブルに日付型で追加することができるのでしょうか?お知恵をいただければ幸いです。
回答を見る
  • ベストアンサー

VBAからcsvを読み込みテープルに追加する際日付型にしたいのですが?

VBAからcsvを読み込みテープルに追加する際日付型にしたいのですが? ACCESS2003を使用しています 商品管理.mdbの中に 下のような商品TBLがあります 商品ID(aut_no)  納入日(日付/時刻型) 仕入NO(キスト型) 管理コード(キスト型) 12          2010/03/26       36542 22          2010/05/21       69856         256 25          2010/06/03       58596         123 30          2010/07/10       25546 管理.csvがあり、下記の内容です(左カラムから納入日,仕入NO,管理コード) 20100228,2566,256 20100326,6824,123 20101226,6589,566 20100425,2548,456 20100603,6879,222 20100326,1175,1111 商品管理.mdbから管理.csvを読み込み 納入日と仕入れNOがマッチした場合に管理コードを商品TBLに追加するといったものを作りたいと思っています。 商品管理.mdbの商品TBL   納入日(日付/時刻型)をテキスト型にして 20100228といった8桁表記にすれば以下のコードで出来るのですが データベースの仕様上納入日(日付/時刻型)にしないといけないのです、 そうすると実行時エラー'-2147352571 (800020005)'種類か一致しません。 とエラーがでてうまくいきません。 どなたかお知恵をお貸しください。 Private Sub コマンド0_Click() Const adOpenStatic = 3 Const adLockOptimistic = 3 Const ForReading = 1 Dim tuika_no As Integer Set objConnection = CreateObject("ADODB.Connection") Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Open _ "Provider = Microsoft.Jet.OLEDB.4.0; " & _ "Data Source = c:\test\商品管理.mdb" objRecordSet.Open "SELECT * FROM 商品TBL", _ objConnection, adOpenStatic, adLockOptimistic Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("C:\test\管理.csv") tuika_no = 0 Do Until objFile.AtEndOfStream strkanri = objFile.ReadLine       objRecordSet.Filter = "納入日=" & arrkanri(0) _ & " AND 仕入NO =" & arrkanri(1) If (Not objRecordSet.EOF) Then objRecordSet("管理コード") = arrkanri(2) objRecordSet.Update End If tuika_no = tuika_no + 1 Loop MsgBox "管理番号を取込みました。" objRecordSet.Close objConnection.Close End Sub

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

  • ベストアンサー
  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.1

試しにやってみました。当方の試験環境に合わせたコードですので、ご質問とは異なっている箇所がありますが、ご参考まで。strDateのところはアメリカ流の並びにすべきでしょうが、手抜きです。 Sub test() Dim cn As ADODB.Connection Dim objFSO As Object, objFile As Object Dim strkanri As String Dim buf As Variant Dim mySQL As String, strDate As String Set cn = CurrentProject.Connection Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(CurrentProject.Path & "\" & "管理.csv") Do Until objFile.AtEndOfStream strkanri = objFile.ReadLine buf = Split(strkanri, ",") strDate = "#" & Left(buf(0), 4) & "/" & Mid(buf(0), 5, 2) & "/" & Right(buf(0), 2) & "#" mySQL = "UPDATE Table1 SET 管理コード=" & buf(2) & " WHERE 納入日=" & strDate & " AND 仕入NO=" & buf(1) & ";" cn.Execute mySQL Loop Set objFile = Nothing Set objFSO = Nothing cn.Close: Set cn = Nothing End Sub

matupo
質問者

お礼

mitarashi様 早速お知恵拝借させて頂ありがとう御座います。 こちらの環境ですと strDate = "#" & Left(buf(0), 4) & "/" & Mid(buf(0), 5, 2) & "/" & Right(buf(0), 2) & "#" の#をつけると抽出条件でデーター型が一致しませんとエラーが出ます。 そこで strDate = Left(buf(1), 4) & "/" & Mid(buf(1), 5, 2) & "/" & Right(buf(1), 2) に変更したところエラーはなくなりました。 エラーはないのですが WHERE 納入日=" & strDate & " AND 仕入NO=" & buf(1) & ";" がうまく機能してないようです。 Table1 の中と管理.csv中には 同じ納入日と仕入NOがあるのですが管理コードに追加できません。 ちなみにTable1はマイクロソフトのMSSQLからのリンクテーブルです 原因が分かりません、このような時はどのようにして原因究明すれば良いのでしょうか? またよきアドバイスを何卒お授けくだされば助かります。 管理コード

その他の回答 (1)

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.2

#1です。SQL Serverは分かりませんので、一般論ですが、 mySQL = "UPDATE Table1 SET 管理コード=" & buf(2) & " WHERE 納入日=" & strDate & " AND 仕入NO=" & buf(1) & ";" の納入日と、仕入れNOを変数でなく、存在する値を定数で与えたら機能するのでしょうか。 それでも駄目な場合、 mySQL = "SELECT * FROM Table1 WHERE 納入日=" & strDate & " AND 仕入NO=" & buf(1) & ";" として、 rs.Open mySQL, cn, adOpenKeyset, adLockOptimistic ならば、レコードセットが取得できるでしょうか。 ご確認下さい。 実は、最初はこの方法で取得したレコードセットをUpdateするコードを書きましたが、もっと短く出来ないかと#1の形にしました。

matupo
質問者

お礼

mitarashi様 アドバイスありがとうございます、 いろいろ試しているのですが、以下を試しました MsgBox "strDateの値は" & strDate & "です" mySQL = "UPDATE Table1 SET 納入日= " & strDate & ";" strDateの値は2010/02/28ですと表示されますが 納入日の全部のレコードが以下の数値になります 1900/04/22 16:00:00 同じように mySQL = "UPDATE Table1 SET 仕入NO= " & buf(1) & ";" 先頭が0から始まる数値は0が取り除かれてしまいます、 先頭のゼロも残したままでテーブルに追加したいのです あと以下追加しましたがレコードセットはどのようにして取得するのでしょうか? Set rs = CreateObject("ADODB.Connection") rs.Open mySQL, cn, adOpenKeyset, adLockOptimistic 完成までもう少しだとは思うのですが、今しばらくお付き合い頂きたく存じます。 よろしくお願いします。

matupo
質問者

補足

mitarashi様 お世話になっています、 上記の疑問が以下のようにコードを修正することで解決しました。 mySQL = "UPDATE dbo_tbl03_jyutyuu SET 管理番号= " & buf(0) & " WHERE 受注日=# " & strDate & " # AND 連絡先電話番号='" & buf(7) & "';" 日付型を # #で囲いました → # " & strDate & " # 文字型を ' 'で囲いました → '" & buf(7) & "' 結局私がSQL serverの基本的な事を知らなかっただけでした、 あとすべてmitarashi様のコードでうまくいっています。 今回はmitarashi様の貴重なお時間とお知恵を拝借できて期待通りのものが出来ました、 大変感謝いたします、有難う御座いました。

関連するQ&A

  • ACCESS VBA ヘッダなしCSVの入力について

    ACCESS VBA ヘッダなしCSVの入力について ”商品管理.mdb”の中に 下のような”商品TBL”があります 商品ID   納入日     仕入NO    管理コード  9   20100305     25596 10   20100326     19229 11   20100412     65841 12   20100423     26845 上の商品TBLテーブルの管理コードを入れる元データとして 下のような”管理.csv”があります 20100326,20100305,123 20100326,20100326,456 20100326,20100412,222 20100326,20100423,1111 ヘッダーはありませんが 1列目:納入日、2列目:仕入NO、3列目:管理コード になります。 やりたいことは ”商品TBL”の ”納入日”と”仕入NO”と 管理.csvの”納入日”と”仕入NO”(ヘッダーはありませんが1カラムと2カラム) が一致した場合、管理.csvの管理コード(3カラム目)を ”商品TBL”の管理コードに入力したいのです。 色々参考にしているのですがやり方がわかりません 今何とか”商品TBL”に管理.csvを読み込ませる所までは出来ましたが ただ単にデータを追加させる事が出来た程度です。 商品TBLと管理CSVを比較してマッチしたら管理コードを入力できる方法を どなたか、お教え願います。 以下現在の状況です Private Sub コマンド0_Click() Const adOpenStatic = 3 Const adLockOptimistic = 3 Const ForReading = 1 Set objConnection = CreateObject("ADODB.Connection") Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Open _ "Provider = Microsoft.Jet.OLEDB.4.0; " & _ "Data Source = c:\test\商品管理.mdb" objRecordSet.Open "SELECT * FROM 商品TBL", _ objConnection, adOpenStatic, adLockOptimistic Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("C:\test\管理.csv") Do Until objFile.AtEndOfStream strkanri = objFile.ReadLine MsgBox strkanri arrkanri = Split(strkanri, ",") objRecordSet.AddNew objRecordSet("納入日") = arrkanri(0) objRecordSet("仕入NO") = arrkanri(1) objRecordSet("管理コード") = arrkanri(2) objRecordSet.Update Loop objRecordSet.Close objConnection.Close End Sub

  • コンパイルエラー 変数が定義されていません

    コンパイルエラー 変数が定義されていません 下記URLの質問を参考にVBAに挑戦しています http://questionbox.jp.msn.com/qa5863136.html 下記コードを既存のACCESSの中に新規作成したコマンドボタンに 組み込んで実行したところ 下記変数にコンパイルエラー 変数が定義されていませんと出てきます、 objConnection objRecordSet strkanri arrkanri 自分なりに Dim ~としたのですがうまくいきません どのように変数を宣言してよいかお教え願います。 記述コード Private Sub コマンド0_Click() Const adOpenStatic = 3 Const adLockOptimistic = 3 Const ForReading = 1 Set objConnection = CreateObject("ADODB.Connection") Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Open _ "Provider = Microsoft.Jet.OLEDB.4.0; " & _ "Data Source = c:\test\商品管理.mdb" objRecordSet.Open "SELECT * FROM 商品TBL", _ objConnection, adOpenStatic, adLockOptimistic Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("C:\test\管理.csv") Do Until objFile.AtEndOfStream     strkanri = objFile.ReadLine     MsgBox strkanri     arrkanri = Split(strkanri, ",")     objRecordSet.Filter = "納入日=" & arrkanri(0) _               & " AND 仕入NO ='" & arrkanri(1) & "'"     Do While (Not objRecordSet.EOF)       objRecordSet("管理コード") = arrkanri(2)       objRecordSet.Update       objRecordSet.MoveNext     Wend   Loop objRecordSet.Close objConnection.Close End Sub

  • CSVファイル

    CSVファイルを1行ずつ比較して読み込み、一致した行を別ファイルに記述していこうと思っています。 現在、csvファイルを読み込む所まで出来ています。 比較して別ファイルに記述する方法を教えて下さい。 もしくはアドバイスください。 【ファイルの中身】 "09/09/2005 0:00:00,aaa,bbb,ccc" 【比較条件】 当日の日付を取得し、年月日だけで比較する Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("c:\test.csv") Do while objFile.ReadLine <> ""         'IF文を記述(条件:日付)        '別ファイルに記述する Loop objFile.close Set objFileSystem = Nothing Set objFile = Nothing

  • 【ACCESS】インポート定義を使わないCSVインポート

    ACCESS VBAにてMDBにSQL文でCSVデータをINSERTしようとしています。INSERT自体はうまくいったのですが、データの型をうまくそろえられません。2日程ネットサーフィンしているものの良いサンプルを見つけられません。有識者の方、ご存知でしたら是非教えてください! まず、CSVデータは以下のようなものです。 ===aaa.csv=== 00000001,2009/1/31 00000002,2009/1/31 ・ ・ A000001,2009/1/31 Z000002,2009/1/31 ========== これを 既存テーブル:aaa_TBLに取り込ませたく、以下のSQL文を書きました。 INSERT INTO aaa_TBL(カラム1,カラム2) SELECT FORMAT([aaa#CSV].F1,'0000000'),[aaa#CSV].F2 FROM aaa#csv IN 'C:\' 'Text;HDR=NO' これにて「0000001」と「000002」等のレコードは正常に取り込むことができましたが、「A000001」「B000002」等のデータは取り込まれず、NULLにて登録されておりました。 (aaa_TBL自体はカラム1=テキスト型、カラム2=日付型でCreateされております。) これを回避したく、いろんなサイトを訪問したのですが、ほとんどがインポート定義を使った方法を推奨しておりました。 しかしながら、私にはどうしてもインポート定義が理解できないんです! 「VBAにて○○.iniを作成する方法」などをよく見かけるんですが、できるだけ他の方法を検討したいと考えております。(今後、ACCESS VBAから他言語への乗り換えを考えているとか、他CSVにてインポートされるテーブルの数が30個程あるので、インポート定義ファイルの管理がつらいな・・・とか色々他にも理由はあるんですが・・・・) 何か良い方法はないでしょうか?! やはりインポート定義を作らないとだめでしょうか?! その場合、簡単なサンプルコードなどを頂けますと非常に助かります。。。(MSサイトのサンプルコードは理解できませんでした。。。) まだVBAを勉強し始めて2週間なので、色々突っ込みどころはあると思いますが、どうぞよろしくお願いしますm(_ _)m

  • vbsで最後の行を削除する

    csvファイル(test.csv)からフラグが1のものを抽出するのですが 最終行に改行がはってしまうので、最終行を削除してcsvファイルを保存したいのですが、 うまくいきません。ご教授ください。 Dim objADO Dim i Dim wsql Dim rs Dim wHeader Dim wData Dim objFSO Dim objFile Set objADO = CreateObject('ADODb.connection') objADO.Open "Driver={Microsoft Text Driver (*.txt;*csv)};"&_ "DBQ=C:\test;"&_ "ReadOnly=1" '抽出条件 wsql="select * from test.csv where フラグ='1'" Set rs =objADO.Execute(Wsql) 'ヘッダ部 wHeader='ID,商品名,商品番号,フラグ" 'データ部 wData="" Do While rs.EOF=False For i = 0 to rs.fields.count - 1 if i = (rs.fields.count -1) then wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & chr(13) else wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & "," end if next rs.MoveNext loop '最終改行削除? rs = Left(wData,Len(wData) - Len(chr(13))) 'ファイル出力 set objFSO = createObject("Scripting.FileSystemObject") set objFile = objFSO.OpentextFile("c:\test\test.csv",2, true) if err.Number = 0 then objFile.WriteLine(wHeader) objFile.WriteLine(wData) objFile.close end if set objFile = Nothing set objFSO = Nothing set objADO = Nothing ****************************************** ID,商品名,商品番号,フラグ 100,パソコン,100-12,1 200,ペン,200-11,1 ***ここの改行を削除する***** 〔EOF〕

  • 特定のワークシートcsvファイル書き出しほか

    エクセルブックの中身が、 1番目 graphシート 2番目から19番目 ワークシート で構成されているエクセルファイルが100個 AAAというフォルダに入っています。 それぞれのエクセルブックにあるシートを、ブックのファイル名にしたフォルダを作成し、その中にcsvで書き出すプログラムを作りました。 また、AAAのフォルダの1つ上のフォルダ(VBA実行するカレントフォルダ)には、テキストファイルもあり、作成されたフォルダに合わせてコピーするようにしています。 一応、期待通りの動作をしましたが、スッキリとしたプログラムとするために、アドバイスをいただけないでしょうか? また、できれば、それぞれのブックの2番目から7番目のワークシートのみをcsvファイルで書き出したいと思い、シートを2番目から順にアクティブにして書き出すように変更しても1番目のグラフシートからcsvになってしまいました。 特定のワークシートのみをcsvファイルで書き出すにはどのように書いたら良いでしょうか? よろしくおねがいしむす Sub ファイル一括作成()     Application.ScreenUpdating = False         '対象ブックの選択     'フォルダ内のブックを順次選択     Dim FolderPath As String     Dim objFSO As Object     Dim objBook As Object     Dim objFiles As Object     Dim objFile As Object     Dim mysma4 As Object     Set objFSO = CreateObject("Scripting.FileSystemObject")     FolderPath = ActiveWorkbook.Path & "\AAA"     Set objBook = objFSO.GetFolder(FolderPath)     Set objFiles = objFSO.GetFolder(FolderPath).Files     Set mysma4 = objFSO.GetFile(ActiveWorkbook.Path & "\fig_all.TXT")     For Each objFile In objFiles      If objFSO.GetExtensionName(Path:=objFile) Like "xlsx" Then     'ベースファイル名フォルダ作成&sma4ファイルコピー       objFSO.CreateFolder Path:=FolderPath & "\" & objFSO.GetBaseName(objFile)       mysma4.Copy Destination:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\fig_all.TXT"     '各ファイルcsv書き出し      Workbooks.Open objFile.Path       For Each ws In Worksheets '各シートに対して処理を繰り返す           ws.Activate           'ベースファイルと同じ階層に出力           ActiveWorkbook.SaveAs _           Filename:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\" & ws.Name & ".csv", _           FileFormat:=xlCSV       Next ws       ActiveWorkbook.Close SaveChanges:=False      Else      End If     Next     MsgBox "ファイル作成が完了しました。"     Set objFSO = Nothing     Set objBook = Nothing     Set objFiles = Nothing     Set mysma4 = Nothing     Application.ScreenUpdating = True End Sub

  • SQLServerトリガー(データ追加時)

    Microsoft SQL SERVER 2005でデータ更新/追加時に起動するトリガーを 作成したいのですが記述方法がわかりません。 テーブル:TBL_SHOHIN SHOHIN_NAME NVARCHAR(50) /* 商品名 */ SAKUSEI_DATE datetime /* 作成日付 */ KOSHIN_DATE datetime /* 更新日付 */ このTBL_SHOHINテーブルに追加があった時は、作成日付(SAKUSEI_DATE)にシステム日付をセット このTBL_SHOHINテーブルに更新があった時は、更新日付(KOSHIN_DATE)にシステム日付をセット 更新時は下記の記述でうまくいったのですが、追加時をどう記述すればいいの でしょうか? create TRIGGER trgSHOHIN ON TBL_SHOHIN FOR INSERT, UPDATE AS BEGIN UPDATE TBL_SHOHIN SET KOSHIN_DATE = GETDATE() END RETURN

  • wshでcsvファイルのソートを行いたい

    wshのプログラムで困っているため教えてください。 wshでcsv(カンマ区切り)のファイルのソートを行い、Escel形式で保存するプログラムを書いています。 調べてみたところ、wshではソート関数がないようで、 adodbのsort関数を使用して対処しようとしていますが、どうもうまくいきません。 (※adodbの必要はないのですが、ExcelVBAのsortのコードを書こうとするとエラーになってしまったので、adodbにしています。) <仕様> csvファイルのソートのキーになるのは、「判定区分」の値で昇順に行いたいです。 csvファイルの一行目は、カラム名としてソート対象にはなりません。 読み込んだcsvファイルをexcel形式に保存したいです。 ■csvファイルの形式は、以下のような形です。 性別,年代,判定区分,生年月日,日付 女性,10,0,2010/01/10,2013/7/7 23:57 男性,50,2,2000/03/30,2013/7/7 13:7 女性,10,0,1990/01/20,2013/7/7 15:22 女性,20,1,2001/12/10,2013/7/7 8:10 *----------------------------------- <ソース> Set con = CreateObject("ADODB.Connection") With con .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path & ";" _ & "Extended Properties='text;HDR=Yes;FMT=Delimited'" .Open End With Set rec = CreateObject("ADODB.Recordset") rec.Open "select * from " & csvfile & " order by 判定区分", con *----------------------------------- うまくいかないため ↓でも書いています。 *----------------------------------- Const adDate = 7 Const adVarChar = 200 Dim ans Set objADO = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") Set re = CreateObject("VBScript.RegExp") rs.Fields.Append "性別", adVarChar, 255 rs.Fields.Append "年代", adVarChar, 255 rs.Fields.Append "判定区分", adVarChar, 255 rs.Fields.Append "生年月日", adDate rs.Fields.Append "日付", adDate rs.Open ans = "" rs.Sort ="判定区分 ASC" rs.MoveFirst Do While Not rs.EOF ans = ans & rs.Fields(0).Value & vbCrLf rs.MoveNext Loop MsgBox ans エラーになってしまいます。 ソート処理だけですでににっちもさっちもいかないため、教えていただきたいです。 どうぞ宜しくお願いいたします。

  • 【EXCEL VBA】ローカルmdbからデータを取得したい

    (環境)  WindowsXP  Excel2003  Access2003 現在、SQLサーバーからデータを取得しています。 下記のソースです(一部抜粋) Private Const SRC_SQL = "Provider=SQLOLEDB.1;User ID=testid;Password=testpass;Data Source=TEST-DB-1;Initial Catalog=testDB" Private Const TBL_TEST = "TEST.テストテーブル" Public Sub TEST_PRO Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = CreateObject("ADODB.Connection") cn.CommandTimeout = 0 cn.Open SRC_SQL strSQL = "SELECT X.*, FROM " & TBL_TEST & " X" strSQL = strSQL & " WHERE X.担当者CD = '" & wNAME & "'" strSQL = strSQL & " AND X.オープン日 >= '" & start_dt & "'" strSQL = strSQL & " AND X.オープン日 < '" & end_dt & "'" strSQL = strSQL & " ORDER BY X.オープン日 ASC" Set rs = CreateObject("ADODB.Recordset") rs.Open strSQL, cn With rs ~~~ End With Set rs = Nothing End Sub これを、SQLサーバーではなく、 C:\TESTACCESS.mdbのテーブル:テストテーブル からデータを取得するように変更したいのですが、 どのようにコーディングすればよろしいでしょうか? よろしくお願いします。

  • DOS の BAT処理について

    お世話になります。 下記のようなBATを見よう見まねで作りました。 私が作りたいのは、「製品情報.xls」と言うファイルの更新日を見て 更新日が今日であったら、メッセージ「同じ日付です。」を表示したい だけなのです。 現状では、ファイルの更新日と今日の日付が同じなのに、何故か メッセージが出てこないのでしょうか? お忙しいとは思いますが宜しくお願い致します。 Option Explicit Dim objFileSys Dim strScriptPath Dim strFilePath Dim objFile Dim strDate Dim hizuke2 dim hizuke 'ファイルコピー用------------------------------------ Dim fso, TargetFolder, MyFile, filename Set fso = CreateObject("Scripting.FileSystemObject") 'ファイルコピー用------------------------------------ Set objFileSys = CreateObject("Scripting.FileSystemObject") Set objFile = objFileSys.GetFile("\\10.20.32.21\共有\製品情報.xls") hizuke = Date hizuke2 = Left(objFile.DateLastModified,10) WScript.echo "最終アクセス日:" & hizuke2 & " " & "今日:" & hizuke if hizuke = hizuke2 then WScript.echo "同じ日付です。"

専門家に質問してみよう