• ベストアンサー

CSVファイルのインポート

tomo316の回答

  • ベストアンサー
  • tomo316
  • ベストアンサー率35% (51/142)
回答No.1

ぱっと見。 ヒントはスコープの問題かな。 (変数を参照できる範囲をスコープと呼びます。) ローカル変数はプロシジャー内のみ有効。 'Call FileTuika 'End Sub 'Sub FileTuika() コメントにすれば動くかな? dbs.Execute sqlが越えても、次のステップでエラーになりそう。 それと Option Explicit をつけておいた方が良いよ。

関連するQ&A

  • ACCESS VBA CSVのインポート ファイル名指定→ファイル名選択

    現在、テキストボックスにファイル名を入れるとCSVファイルがインポートされ、テキストボックスに入れたファイル名からACCESSのテーブルにFileNameの項目の追加、書き込み等ができるプログラムを作りました。 ですが、このプログラムを根本的に修正してほしいとの事で、困ってます。 テキストボックスにファイル名を入れるのではなく、指定のフォルダからファイル名を複数選択し、まとめてインポートしたいという事でした。 この場合だと、プログラム自体がまったく変わりますよね? FileNameの追加等は不可能ではないでしょうか? 現在のプログラムを記載しますので、どこを修正すればいいかアドバイスお願いします。 Private Sub Cmd_01_Click() Dim ercd As Integer Dim LsName As String Dim TName As String Dim ITName As String Dim Name1 As String Dim Name2 As String Dim teigi As String Dim SQL As String Dim aa As Long Dim mySQL As String Dim db As Database If Nz(Me.txt_01) = "" Then MsgBox "インポートするファイル名を入力して下さい", vbOKOnly, "エラー" Me.txt_01.SetFocus Exit Sub End If 'ファイル名の取得 strError = 0 LsName = "\\St1\第2業務部\$運用\1010030 アールジービー\業務\RGB一時作業ファイル\なるには不備チェック\TESTkanno\" TName = Me.txt_01 LsName = LsName & TName & ".csv" ITName = "T_Mas" 'インポートの確認 ret = MsgBox(TName & "をインポートしますか?", vbYesNo + vbQuestion, "インポート確認") If ret = vbNo Then Exit Sub End If Debug.Print LsName 'レコードの追加 teigi = "RGB定義" DoCmd.TransferText acImportDelim, teigi, ITName, LsName, True ret = MsgBox(TName & "をマスターに追加しますか?", vbYesNo + vbQuestion, "インポート確認") If ret = vbNo Then Exit Sub End If SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,学校識別コード,学校名,学校分類名,メールアドレス,名前,ふりがな,性別,生年月日,職業,高校所在地,高校名,学年,郵便番号,都道府県,区市町村&町域,番地以下,電話番号,FileName,区分,不備,不備理由,yu,gid,保留,処理済,件数報告日,納品日 )" & _ " SELECT [" & TName & "].[ID1], [" & TName & "].[ID],[" & TName & "].[処理状況], [" & TName & "].[請求日]," & _ " [" & TName & "].[学校識別コード], [" & TName & "].[学校名], [" & TName & "].[学校分類名], [" & TName & "].[メールアドレス]," & _ " [" & TName & "].[名前], [" & TName & "].[ふりがな], [" & TName & "].[性別], [" & TName & "].[生年月日]," & _ " [" & TName & "].[職業], [" & TName & "].[高校所在地], [" & TName & "].[高校名], [" & TName & "].[学年]," & _ " [" & TName & "].[郵便番号], [" & TName & "].[都道府県], [" & TName & "].[区市町村&町域], [" & TName & "].[番地以下]," & _ " [" & TName & "].[電話番号], [" & TName & "].[FileName], [" & TName & "].[区分], [" & TName & "].[不備], [" & TName & "].[不備理由], [" & TName & "].[yu], [" & TName & "].[gid]," & _ " [" & TName & "].[保留], [" & TName & "].[処理済], [" & TName & "].[件数報告日],[" & TName & "].[納品日], From" & "LsName" Debug.Print SQL Name1 = TName & ".csv" Name2 = Left(TName, Len(TName) - 5) ret = MsgBox(Name1 & "を FileName、" & Name2 & "を 区分に追加しますか?", vbYesNo + vbQuestion, "インポート確認") Dim sql1 As String sql1 = "Update T_Mas SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'" & " WHERE FileName Is Null AND 区分 Is Null" DoCmd.RunSQL sql1 End Sub

  • リストボックス 複数選択の場合の値取得

    ACCESS2003を使用しています。 今、下記のプログラムにて リストボックスからファイル名を選び CSVをインポートさせ、更に選択したファイル名を新しいフィールドに書き込みをする。というシステムを作っています。 現在のプログラムですと、一つを選択した場合はうまく書き込めます。 ですが、複数同時選択する事はできますでしょうか? 長くて見づらいプログラムですが、参考までに掲載します。 よろしくお願いします。 Private Sub Form_Load() Dim oFSO As Object Dim oFile As Object Dim sTmp As String Const FolderPath = "\\St1\第2業務部\$運用\TESTkanno" sTmp = "" Set oFSO = CreateObject("Scripting.FileSystemObject") For Each oFile In oFSO.GetFolder(FolderPath).files If (Right(oFile.Name, 3) = "csv") Then sTmp = sTmp & ";" & Left(oFile.Name, InStr(oFile.Name, ".") - 1) End If Next If (Len(sTmp) > 0) Then sTmp = Mid(sTmp, 2) End If Me.lst_01.RowSource = sTmp 'Me.lst_01 = Null Set oFSO = Nothing End Sub Private Sub Cmd_01_Click() Dim ercd As Integer Dim LsName As String Dim TName As String Dim ITName As String Dim Name1 As String Dim Name2 As String Dim teigi As String Dim SQL As String Dim aa As Long Dim mySQL As String Dim db As Database Dim i As Integer Dim varData As Variant Dim strSelected As String strSelected = vbNullString With lst_01 For Each varData In .ItemsSelected strSelected = strSelected & .ItemData(varData - 1) & " " Next End With 'ファイル名の取得 strError = 0 LsName = "\\St1\第2業務部\$運用\TESTkanno\" TName = Left(strSelected, Len(strSelected) - 1) LsName = LsName & TName & ".csv" ITName = "T_Mas" 'レコードの追加 teigi = "RGB定義" DoCmd.TransferText acImportDelim, teigi, ITName, LsName, True SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,学校識別コード,学校名,学校分類名,メールアドレス,名前,ふりがな,性別,生年月日,職業,高校所在地,高校名,学年,郵便番号,都道府県,区市町村&町域,番地以下,電話番号,FileName,区分,不備,不備理由,yu,gid,保留,処理済,件数報告日,納品日 )" & _ " SELECT [" & TName & "].[ID1], [" & TName & "].[ID],[" & TName & "].[処理状況], [" & TName & "].[請求日]," & _ " [" & TName & "].[学校識別コード], [" & TName & "].[学校名], [" & TName & "].[学校分類名], [" & TName & "].[メールアドレス]," & _ " [" & TName & "].[名前], [" & TName & "].[ふりがな], [" & TName & "].[性別], [" & TName & "].[生年月日]," & _ " [" & TName & "].[職業], [" & TName & "].[高校所在地], [" & TName & "].[高校名], [" & TName & "].[学年]," & _ " [" & TName & "].[郵便番号], [" & TName & "].[都道府県], [" & TName & "].[区市町村&町域], [" & TName & "].[番地以下]," & _ " [" & TName & "].[電話番号], [" & TName & "].[FileName], [" & TName & "].[区分], [" & TName & "].[不備], [" & TName & "].[不備理由], [" & TName & "].[yu], [" & TName & "].[gid]," & _ " [" & TName & "].[保留], [" & TName & "].[処理済], [" & TName & "].[件数報告日],[" & TName & "].[納品日], From" & "LsName" Name1 = TName & ".csv" Name2 = Left(TName, Len(TName) - 5) ret = MsgBox(Name1 & "を FileName、" & Name2 & "を 区分に追加しますか?", vbYesNo + vbQuestion, "インポート確認") Dim sql1 As String sql1 = "Update T_Mas SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'" & " WHERE FileName Is Null AND 区分 Is Null" DoCmd.RunSQL sql1 End Sub

  • 【AccessVBA】ダイアログで複数選択しCSVインポートする

    お世話になります 現在1ファイルごとでインポートさせていますが 複数選択でインポートさせたいのですがわかる方ご教授お願いします。 ■現在のVBA '実行ボタンのイベント Private Sub 参照_Click() Dim strFileName As String 'ファイルを開くダイアログを表示 strFileName = GetFile("") If Len(strFileName) > 0 Then Me.テキスト1 = strFileName Else MsgBox "ファイルは選択されていません! End If End Sub Private Sub 実行_Click() TextConv Me.テキスト1, "定義名", "テーブル名" End Sub 'テキストコンバートルーチン Sub TextConv(strFle As String, strInp As String, strTbl As String) If MsgBox("インポートしますか?", 4, "実行確認") = vbYes Then DoCmd.TransferText acImportDelim, strInp, strTbl, strFle, False MsgBox "テーブルデータを更新しました" End If End Sub 上記の内容を変更だけでよいのか まったく書き直しかどうかもわかっていません わかる方ご教授よろしくお願いします。

  • ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルを

    ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルをすべてアクセスのテーブルにインポート使用と思っています。 ところがCSVファイルの数の分だけ、1つめのCSVファイルの中身が繰り返しインポートされてしまっています。 どの部分に誤りがあるのでしょうか? お知恵を拝借できますでしょうか・・・。 コードは以下になります。 Private Sub cmd06_Click() Dim MyFile As String Dim MyName As String Dim MyName02 As String Dim strFolderName As String strFolderName = GetFolderName() 'フォルダ選択ダイアログを表示 If Len(strFolderName) > 0 Then '選択結果を評価 MyFile = strFolderName & "\*.csv" '【拡張子csvのファイルのみ取得】 MyName = Dir(MyFile, vbNormal) MyName02 = "\" & MyName Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If GetAttr(strFolderName & "\" & MyName) <> vbDirectory Then DoCmd.TransferText acImportFixed, "T03_インポート定義", "T03_全CSVデータ", strFolderName & MyName02, False, "" '【取得したファイルをインポート】 End If End If MyName = Dir Loop Else MsgBox "フォルダは選択されませんでした" End If MsgBox "データのインポートが終了しました" End Sub

  • 更新クエリ 複数の抽出条件の書き方

    いつもアドバイスありがとうございます。 表題の通り、下記コード(一部)で更新クエリをかけてますが、 抽出条件として、「FileNameと区分が空白の場合」という抽出条件を付け加えたいです。 色々調べてみたのですが、 UPDATE句の続きに、「& "where File Name = "" & 区分 = "" "」 をつけたのですが、これをつけると何も更新されなくなってしまいます。 何かアドバイスがあればお願いします。 Name1 = TName & ".csv" Name2 = Left(TName, Len(TName) - 5) ret = MsgBox(Name1 & "をFileName ・ " & Name2 & "を区分に追加しますか?", vbYesNo + vbQuestion, "インポート確認") Dim sql1 As String sql1 = "Update T_Mas SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'" DoCmd.RunSQL sql1

  • Access テキスト インポート

    現在指定したファイルしかインポートしが出来ないのでこれを 指定したファイルをインポートしたいのですがどのようすれは、いいでしょうか?よろしくお願いします。 Private Sub コマンド5_Click() On Error Resume Next Dim MsgNo As Integer Dim Msg1, Msg2, Msg3 As String Dim su As String Dim cut As Integer Dim fd As String Dim suu As String Dim db As Database Dim d1 As Recordset Msg1 = " インポートを開始します。" Msg2 = "「DAT」ファイルがありません。" Msg3 = "「DAT」ファイルを c:\DATデータにコピーし、再度実行して下さい。" MsgNo = MsgBox(Chr(9) & Msg1 & Chr(9), 1) If MsgNo = 2 Then 'キャンセルボタンで終了 GoTo Exit_インポート_Click End If EmptyAllTable 'テーブルクリア Set db = CurrentDb Set d1 = db.OpenRecordset("t_製品データ") fd = Dir("C:\DATデータ\*.dat") If fd = "" Then 'ファイルがなければ、メッセージを表示、処理を戻します。 Beep MsgNo = MsgBox(Msg2 & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Msg3, 16) GoTo Exit_インポート_Click End If

  • 更新クエリで変数は使えない?

    下記、コードの一部分です。 Name1をFileNameに、 Name2を区分に入れたいです。 メッセージボックスより、Name1・Name2に入れたい値が入っているのは確認できてますが、 実行させると、メッセージボックスが出た後、 パラメーターボックスが出てきて、Name1?Name2?と値を聞いてきます。 そこに、値を挿入すると更新はされるものの、パラメーターボックスで入力せず、それぞれに入っている値をそのまま入れたいです。 可能でしょうか? Name1 = TName & ".csv" Name2 = Left(TName, Len(TName) - 5) ret = MsgBox(Name1 & "をFileName ・ " & Name2 & "を区分に追加しますか?", vbYesNo + vbQuestion, "インポート確認") Dim sql1 As String sql1 = "Update T_Mas SET FileName = Name1,区分 = Name2 " DoCmd.RunSQL sql1

  • CSVファイルをインポートするマクロについて

    CSVファイルをインポートするマクロを作成しようと思っているのが、作り方がわかりません。 アドバイスを下さい。 インポートするCSVの書式 "AAA","CC","DFD" "BBB","FF","HHH" "JJ","LL","JI" "Skip" "A","Y","JI","Y","JI" "B","L","JI","JI" "C","IL","JI" 1~3行目はエクセルのD3行,D4行,D5行 4行目はインポートしない 5行目以降はエクセルのA6行,A7行・・・にインポートしたいと思っております。 サンプルを作成して頂けないでしょうか。 下記のソースを元に作成しようとしているのですが、わからなくなってしまいました。 ◆作成途中のソース Sub READ_TextFile() Const cnsTitle = "テキストファイル読み込み処理" Const cnsFilter = "CSV形式ファイル (*.csv),*.csv" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim X() As Variant ' 読み込んだレコード内容 Dim IX1 As Long ' CSV項目カラムINDEX Dim GYO As Long ' 収容するセルの行 Dim lngREC As Long ' レコード件数カウンタ Dim strREC As String ' レコード領域 Dim POS1 As Long ' レコード文字位置INDEX Dim POS2 As Long ' レコード文字位置INDEX ' Applicationオブジェクト取得 Set xlAPP = Application ' 「ファイルを開く」のダイアログでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFilter, _ Title:=cnsTitle) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open strFileName For Input As #intFF GYO = 13 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)" ' 行単位にレコードを読み込む Line Input #intFF, strREC ' (1) ' LineInputより自分で半角カンマを探しCSV→項目分割させる POS1 = 1 IX1 = 0 ReDim X(IX1) ' 配列を初期化 Do While POS1 <= Len(strREC) ' (2) POS2 = InStr(POS1, strREC, ",", vbTextCompare) ' (3) If POS2 < POS1 Then POS2 = Len(strREC) + 1 End If ReDim Preserve X(IX1) ' 配列要素数を再設定 X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1)) ' (4) ' シングルクォーテーション、ダブルクォーテーションで囲まれている場合は ' 両端文字を取り除く If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _ ((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then ' (5) X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2)) End If POS1 = POS2 + 1 IX1 = IX1 + 1 Loop ' 行を加算しレコード内容を表示(先頭は2行目) GYO = GYO + 1 If IX1 >= 1 Then Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X ' 配列渡し (6) End If Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTitle End Sub

  • EXCEL→CSV形式で別ファイルに保存

    EXCELデータ内のある1つのシートのデータをそのまま別ファイル(CSV)に保存したいのですがうまくいかないので教えてください。 本を見ながらこのようなマクロを作ったところ、EXCEL(○○.xls)の指定したシート(keihi)のみをCSV形式で別フォルダ(C:\経費振替)に保存することができたんですが、 元のEXCELも、ファイル名称・形式がCSV(○○.xls→keihi.csv)に変わってしまいます。 エクセルのファイル名、形式は変えずにできる方法ってありますか?? Sub データはきだし() Dim Ret As String Dim Res As Integer Dim FolderName As String Set WK1 = Worksheets("1 依頼書") Set WK4 = Worksheets("keihi") FolderName = "C:\経費振替" Ret = Dir(FolderName, 16) If Ret = "" Then Res = MsgBox("DATA保管用フォルダを作成します。", vbYesNo) If Res = vbYes Then MkDir FolderName End If End If ' Dim Res2 As Integer Res2 = MsgBox("DATAを作成します。", vbYesNo) WK4.Select If Res2 = vbYes Then With WK4 .SaveAs Filename:=FolderName & "\keihi", FileFormat:=xlCSV ←多分ココが何か間違ってるのだと思うんですが。 End With

  • アクセス フィールド名の変更

    フィールド名 [1],[2],・・・・を [090701],[090702],・・・ に変更するように Dim i As String Dim ret As String ret = InputBox("入力例  090701") i = ret DoCmd.RunSQL "SELECT [クエリ112].[1] AS [" & i & "], [クエリ112].[2] AS [" & i + 1 & "], ........中略 End Sub としましたが [090701],[90702],[90703],・・・ 2番目から 090702 になりません。 どのようにすればよいのか教えていただけませんか。