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
ご教授の程、宜しくお願い致します。
お礼
ご回答ありがとうございました。とっても参考になりました。これで問題も解決です。