- 締切済み
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
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- AlexSuns
- ベストアンサー率67% (78/115)
関連するQ&A
- Accessへのエクセルデータインポート
Accessへのエクセルデータインポート 環境：Access2000/WinXP アクセス2000の特定テーブルへ、エクセルデータをインポートするよう組んだのですが、新しくデータを追加すると、これより前に入っていたデータがレコードを残して消えてしまいました。 新規データを追加した際にただの追加としたいのですがどこがおかしいのでしょうか。 Private Sub データ登録_Click() Dim objExcel As Object Dim varFilePath As Variant Dim bln As Boolean Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "受講者情報一覧" Set objExcel = CreateObject("Excel.Application") varFilePath = objExcel.GetOpenFilename("Microsfot Exel (*.xls), *.xls", , "xls選択") If varFilePath <> False Then varxls = varFilePath Else Exit Sub End If Set objExcel = Nothing varxls = varFilePath strrange = "" strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & "へ、インポートします。" DoCmd.DeleteObject acTable, varac If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, varac, varxls, True MsgBox "正常にインポート完了しました。" End If Exit Sub エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & "エラー番号：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbCritical Exit Sub End Sub
- ベストアンサー
- Visual Basic
- エクセルVBA アクセスにインポート
エクセルのデータ（列数、行タイトルは都度かわる）をアクセスにインポートしテーブルを作成したいと思っています。 VBAでこの処理をおこないたく、下記のコードで実行したのですがデバッグがはしってしまいます。 （DとEでデバッグ） 原因がお分かりになる方がおりましたら、教えていただけますでしょうか？ 何卒、よろしくお願い申し上げます。 Function ExcelDataImport() 'On Error GoTo エラー Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "T_TESTTABLE" ' --- A varxls = "C:\Users\AC\Desktop\ACTEST\RAWDATA.xlsx" ' ---Ｂ strrange = "TEST_RAWDATA" ' --- C strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & _ "へ、データ入力を行います。" & Chr(13) & _ "Excelファイルの入力レンジは、 " & strrange & " です。" DoCmd.DeleteObject acTable, varac ' --- D If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ varac, varxls, True, strrange ' -- E MsgBox "データ入力は、正常に完了しました。" End If Exit Function エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & _ "エラー番号：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbCritical Exit Function End Function
- ベストアンサー
- オフィス系ソフト
- Access csvファイルの取り込み
Access2021 2箇所の保存先の違う所からcsvファイルの取り込みについて伺います。 csv取り込みボタンは、２つ用意しています。 1つ目のボタンに、コード記述して動作確認は正常に動作して他のボタンも正常に動作。 2つ目にのボタンに、csvの格納パス名のみ変更後コード記述して動作確認したら全てのボタンが反応しなくなりました。 動作としては、削除クエリでテーブルのデータを削除してから、指定したフォルダからcsvファイルを選択して取り込ます。 同じテーブルを使用して、格納先の違うcsvファイルを使用する操作になります。 コードは、以下の通りです。 ①ボタン1 Private Sub コマンド61_Click() '削除クエリ実行 DoCmd.SetWarnings False DoCmd.OpenQuery "テーブルデータ削除" DoCmd.SetWarnings True Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub On Error GoTo err_sample DoCmd.TransferText acImportDelim, , "インポート先テーブル名", msg, True MsgBox "インポートが終了しました。", vbInformation + vbOKOnly, "処理完了" Exit Sub err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") '2003以降 Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "csvインポートデータのフォルダパス名①" fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "すべてのファイル", "*.*" fDlg.Filters.Add "CSV ﾌｧｲﾙ (*.csv)", "*.csv" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" Me.Refresh End Function ②ボタン2 Private Sub コマンド62_Click() '削除クエリ実行 DoCmd.SetWarnings False DoCmd.OpenQuery "テーブルデータ削除" DoCmd.SetWarnings True Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub On Error GoTo err_sample DoCmd.TransferText acImportDelim, , "インポート先テーブル名", msg, True MsgBox "インポートが終了しました。", vbInformation + vbOKOnly, "処理完了" Exit Sub err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") '2003以降 Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "csvインポートデータのフォルダパス名②" fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "すべてのファイル", "*.*" fDlg.Filters.Add "CSV ﾌｧｲﾙ (*.csv)", "*.csv" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" Me.Refresh End Function ご教授の程、宜しくお願い致します。
- ベストアンサー
- Access（アクセス）
- ファイルオープンの速度を速くするには？
よろしくお願いします。 下記コードでabc.csvを選択すると、Excelツールバーの”開く”で行う場合よりかなり時間がかかります。速度を早くする方法を教えて頂けないでしょうか。 Option Explicit Option Compare Text Sub Start_Click() Dim Fname As String Dim MBErr As Integer MsgBox "abc.csv を選択して下さい" Start: Fname = Application.GetOpenFilename("CSVファイル,*.csv") If Not Right(Fname, 7) = "abc.csv" Then MBErr = MsgBox("ファイル名が違うか、ファイルが選択されていません" _ & Chr(13) & Chr(13) & "abc.csv を選択して下さい", 21) If MBErr = 4 Then GoTo Start Else Exit Sub End If End If Workbooks.Open Fname End Sub
- ベストアンサー
- オフィス系ソフト
- アクセスからエクセルへインポートの際に
アクセスからエクセルへクエリの結果をインポートしています。 そこでワークシートができるのですが、その後、そのワークシート が残るので同じ処理をした際に、同じ名前のワークシートに上書き すると思っていたのですが、新たにワークシートを作成して しまい困っています。 VarAccess = "入力禁止LEJOUR" の部分がワークシート名になりますが 同じ処理をすると入力禁止LEJOUR1というワークシートが横に できてしまいます。 これを入力禁止LEJOURのシートに上書きさせるには どんなコードを使用したらいいでしょうか？ 教えてください。 よろしくお願い致します。 Private Sub コマンド15_Click() On Error GoTo エラー Dim VarAccess As Variant Dim VarExcelpass As Variant Dim strmsg As String VarAccess = "入力禁止LEJOUR" VarExcelpass = "\\Shiob030\共有\生産戦略事業部\03.生産L.C.海\B.指図進捗表(月単位)\07\SS\07SS-LE JOUR.xls" strmsg = VarAccess & "を、Excelファイルへ出力します。" & _ Chr(13) & "出力先は" & VarExcelpass & "、 シート名は" _ & VarAccess & "です。" & Chr(13) & "よろしければ、ＯＫをクリックして下さい。" If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, VarAccess, VarExcelpass, True MsgBox "データ出力は、正常に完了しました。" End If Exit Sub エラー: If Err.Number = 3044 Then MsgBox "Excelファイルのパス指定が間違っています。", vbCritical Else MsgBox "予期せぬエラーが発生しました。", vbCritical End If End Sub
- ベストアンサー
- オフィス系ソフト
- Access VBAについて教えて下さい。
Access VBAについて教えて下さい。 <内容> 選択ボタンを押下するとファイル選択のダイアログ画面が表示されます。 そこから複数ファイルを選択してテキストボックスに選択したファイルを取得します。 実行ボタンを押下するとテキストボックスで取得したファイルを同じテーブルにインポートします。 ※テキストボックスの名前 ＝ FileList <VBA> Private Sub 選択_Click() With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Title = "ファイル選択" .Filters.Add "すべてのファイル", "*.*" .Filters.Add "テキストファイル", "*.txt" .Filters.Add "TSVファイル", "*.tsv" .Filters.Add "EXCELファイル", "*.xls" .AllowMultiSelect = True .InitialFileName = CurrentProject.Path If .Show = -1 Then Me.FileList = .SelectedItems(1) 'ユーザーが [キャンセル] をクリックした場合 Else End If End With End Sub Private Sub 実行_Click() 'テーブル削除 On Error GoTo エラー Dim mySQL As String Dim strName As String Dim strmsg As String Set Db = CurrentDb strName = "テスト" strmsg = "" & strName & "テーブルを削除します。" mySQL = "DROP TABLE " & strName '「はい」ボタンを押下した場合 If MsgBox(strmsg, vbYesNo) = vbYes Then Db.Execute mySQL MsgBox strName & "テーブルを削除しました。", vbCritical MsgBox "インポートします。", vbInformation 'インポート開始 DoCmd.TransferSpreadsheet aclmport, acSpreadsheetTypeExcel8, "テスト", FileList, True MsgBox "インポート完了", vbInformation '「いいえ」ボタンを押下した場合 End If Db.Close: Set Db = Nothing Exit Sub 'テーブルが存在しなかった場合 エラー: MsgBox strName & "テーブルが存在しません。", vbExclamation MsgBox "インポートします。", vbInformation 'インポート開始 DoCmd.TransferSpreadsheet aclmport, acSpreadsheetTypeExcel8, "テスト", FileList, True MsgBox "インポート完了", vbInformation End Sub <困っていること> ファイルを複数選択することは、出来ますがテキストボックスには1ファイルしか取得出来ません。 そのため、インポートも1ファイルのみになってしまいます。 どのようにしたらテキストボックスに複数ファイル名を取得し、インポート出来るのでしょうか？
- ベストアンサー
- Visual Basic
- VBAで同名ファイルの有無を確認させる方法は？
AccessにてCSVファイルをインポートしたあと、所定の場所にインポート済みファイルを移動させる処理をさせています。 インポート済みのファイルと同じ名前のファイル（このファイルはyyyymmdd.csvと日付を基にしたファイル名称になっています）を取り込もうとしたときに、メッセージボックスを表示させて処理を続行するかどうか問わせたいと考えています。 下記のようにVBAを記述してみたのですが、メッセージボックスは表示されず、インポート処理されてしまいます。 If strFile = strImportedFile Then という、条件がまずいのではないかと思っているのですが、目的に適した記述が思いつきません。 どのような記述がふさわしいでしょうか？ ～～～現在の記述～～～ Dim strFile As String Dim strPath As String Dim strImportedFile As String strPath = CurrentProject.Path & "\インポート\" strFile = Dir(strPath & "*.csv") strImportedFile = strPath & "インポート済\" & strFile If strFile = strImportedFile Then MsgBox "すでに処理済の日付のファイルです。" & (Chr(13) & Chr(10)) & "続けますか？", vbOKCancel Exit Sub Else Kill strImportedFile End If DoCmd.SetWarnings False '受け皿になるテーブルをクリアーしてインポート If strFile <> "" Then DoCmd.RunSQL "DELETE * FROM tbl_import" DoCmd.TransferText acImportDelim, "インポート定義", "tbl_import", strPath & strFile, True Name strPath & strFile As strPath & "インポート済\" & strFile End If DoCmd.SetWarnings True '取り込むべき売上ファイルがない場合のためのアラート表示 If strFile = "" Then MsgBox "CSVファイルがありません。" & (Chr(13) & Chr(10)) & "処理を中止します", vbOKOnly Else Exit Sub End If End Sub
- ベストアンサー
- その他(データベース)
- accessのVABを使ったインポートについて
accessへのインポートについて質問です。 VBAをつかってボタンを押すとファイル選択ダイアログが開き選択すると既存のテーブルへインポートするものを作成したいと考えています。 検索して出てきたものを加工して使ってみているのですが理想形になりません。 現状いまのままでも使えてはいるのですがより効率的にしたいと思っています。 具体的には以下の２点を修正したいと考えています。 ・元データは本来はＣＳＶのためＣＳＶのまま取り込みたい 範囲指定の際にExcelの関数を使って求めているためそれをCSV 現状はCSVを一度Excelに修正しています。 ・Ａ２のセルに日付（ユーザー定義ｙｙｙｙ年ｍｍ月ｄｄ日）が入っているためそれをUPDATEだデータに追加したい 現状は入力を求められるためそこに入力すると反映されます。 また、反映時はｙｙｙｙ/ｍｍ/ｄｄという表記で表示をしたいです。 一応Gとしてデータの取得はしていると思うのですがうまくいきません。 取り込むデータをCSVとExcelにしているのはもう一つ取込用のボタンがありそちらの取込はCSVだからです。 （CSVだけで取り込めるようになったらExcelは消します） 独学でネットにあるものをつまんでいる状況のため専門用語などが分からず説明が足りていないところなどありましたらご質問下さい。 宜しくお願い致します。 Private Sub コマンド1_Click() Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub Dim objFileSys As Object Dim fileName As String Dim FN As Variant 'ファイルシステムを扱うオブジェクトを作成 Set objFileSys = CreateObject("Scripting.FileSystemObject") '拡張子無しのファイル名を取得 fileName = objFileSys.GetBaseName(msg) FN = objFileSys.GetAbsolutePathName(msg) Dim b As Long Dim r As Long Dim G As Date With CreateObject("Excel.Application") With .Workbooks.Open(FN) 'G = CDate(.Sheets(fileName).Range("A2").Value) b = .Sheets(fileName).Cells(1, 1).End(-4121).row .Close False End With End With DoCmd.TransferSpreadsheet acImport, , "T_G", msg, True, "B7:I" & b Dim sql As String DoCmd.SetWarnings WarningsOn:=False sql = "UPDATE T_G SET 入金日 = G WHERE Nz(入金日)=''" DoCmd.RunSQL sql DoCmd.SetWarnings WarningsOn:=True Set objFileSys = Nothing On Error GoTo err_sample err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "ダウンロード" '任意のフォルダパスを入れてください fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "Excel Files(*.xls)", "*.xlsx;*.xls" fDlg.Filters.Add "Text Files(*.csv;*.txt)", "*.csv;*.txt" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" End Function
- 締切済み
- Visual Basic
- vbaで環境編巣のパスだけ取得したい
Sub Sample() Dim Env As String, i As Integer Do i = i + 1 If Environ(i) = "" Then Exit Do Env = Env & Environ(i) & Chr(13) & Chr(10) Loop MsgBox Env End Sub このコードを実行すると、パス以外にもいろいろ取得されてしまうのですが パスのみ取得するにはどうすればいいでしょうか？
- ベストアンサー
- その他MS Office製品
- Access VBA フィールドの追加とデータ
こんにちは。 Ａｃｃｅｓｓ２００３のＶＢＡで質問です。 やりたいことは、指定フォルダにある「名簿.csv」をインポートし、テーブルの先頭に、フィールド[Unique_ＩＤ]を追加して、値に（フィールド[姓]＆フィールド[名]）をセットしたいのです。 インポートして、姓が空白のときは、レコードを削除することで、[Unique_ID]にnullがはいらないということはできましたが、肝心なフィールドの追加とレコードの追加がわかりません。 どのような方法があるでしょうか？ ご教授よろしくお願いします。 Dim fpass As String Dim Dlfile As String Dim Fd As FileDialog Dim Fchk As String Dlfile = MsgBox("マスタデータを更新しますか？", vbOKCancel + vbExclamation + vbDefaultButton2) If Dlfile = vbCancel Then GoTo Exit_DT_UP_Click Const msoFileDialogFolderPicker = 4 Set Fd = Application.FileDialog(msoFileDialogFolderPicker) With Fd .Title = "更新データのフォルダを指定してください。" .AllowMultiSelect = False If .Show = False Then GoTo CkErr_DT_UP_Click fpass = .selecteditems(1) End With Dlfile = fpass & "\名簿.csv" Fchk = Dir(Dlfile, vbNormal) If (Fchk = "") Then GoTo CkErr_DT_UP_Click DoCmd.TransferText acImportDelim, "", "名簿", Dlfile, True, "", 65001 'ADO Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.Open "名簿", cn, adOpenKeyset, adLockOptimistic Do Until rs.EOF If IsNull(InStr(rs!姓, "")) Then rs.Delete Else 'レコード追加？ End If rs.MoveNext Loop rs.Close Set rs = Nothing Set cn = Nothing CkErr_DT_UP_Click: Set Fd = Nothing Exit_DT_UP_Click: Exit Sub
- ベストアンサー
- オフィス系ソフト
- 最新版に買い替えた場合、現在のデータは使えますか。
- 最新のWindows 11に古いバージョンの筆まめ17をインストールする方法がわかりません。
- 古いバージョン17の筆まめを新しいパソコンにインストールしようとしましたが、パソコンが認識しません。
