| |
いつもお世話になっております。
現在、CSVファイルをフォームよりインポートし、
任意の条件で抽出した条件でエクスポートできるようにしています。
そこで今回、CSVファイルをインポートする際にインポートしたファイル名を取得したいと考えております。
その目的としまして、エクスポートする際に元のファイル名を含んだファイル名でエクスポートできればということからです。
理想としてはインポートが完了した時点でフォームのテキストボックスにファイル名を表示させ、
エクスポートさせる際にそのテキストを指定するように出来ればと思っております。
現在はテキストボックスに手動で入力したものをファイル名に付与するといった形を取っていますが、
これが自動でファイル名を取得し、テキストボックスに表示されるようになればと考えております。
現在のインポート及びエクスポート時のVBAは以下の通りです。
・インポート
Private Sub import_Click()
DoCmd.SetWarnings False
Application.SetOption "Auto Compact", True
Application.SetOption "Confirm Record Changes", False
Application.SetOption "Confirm Action Queries", False
Application.SetOption "Confirm Document Deletions", False
Dim msg As String
msg = getFilePicker
If msg = "" Then Exit Sub
On Error GoTo err_import
Me.Repaint
DoCmd.TransferText acImportDelim, , "テーブル", msg, True
Me.Repaint
DoCmd.Close
DoCmd.OpenForm "フォーム"
DoCmd.DeleteObject acTable, "名前の自動修正保存エラー"
Exit Sub
err_import:
Select Case Err.Number
Case 3011
MsgBox "ファイルが見つかりません ― 処理を終了します"
Case Else
MsgBox Err.Number & ":" & Err.Description
End Select
Application.SetOption "Confirm Record Changes", True
Application.SetOption "Confirm Action Queries", True
Application.SetOption "Confirm Document Deletions", True
DoCmd.SetWarnings True
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.AllowMultiSelect = False
fDlg.Filters.Clear
fDlg.Filters.Add "CSV ﾌｧｲﾙ (*.csv)", "*.csv"
fDlg.Filters.Add "すべてのファイル", "*.*"
fDlg.FilterIndex = 1
If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = ""
End Function
・エクスポート
Private Sub export_Click()
Dim intReturn As Integer
intReturn = MsgBox("エクスポートします", vbQuestion + vbYesNo, "確認")
If intReturn = vbNo Then Exit Sub
On Error GoTo cmdエクスポート_Click_Err
If DCount("ID", "クエリ1") > 0 Then
DoCmd.TransferText acExportDelim, "", "クエリ1", "C:\***" & "\"条件1_" & Forms!テキストボックス & ".csv", False, ""
End If
If DCount("ID", "クエリ2") > 0 Then
DoCmd.TransferText acExportDelim, "", "クエリ2", "C:\***" & "\"条件2_" & Forms!テキストボックス & ".csv", False, ""
End If
If DCount("ID", "クエリ3") > 0 Then
DoCmd.TransferText acExportDelim, "", "クエリ3", "C:\***" & "\"条件3_" & Forms!テキストボックス & ".csv", False, ""
End If
MsgBox "エクスポートが完了しました" & vbNewLine & "OKをクリックすると保存されたフォルダが開きます", vbInformation, "エクスポート"
Call Shell("Explorer /root,c:\***", 1)
cmdエクスポート_Click_Exit:
Exit Sub
cmdエクスポート_Click_Err:
MsgBox Error$
Resume cmdエクスポート_Click_Exit
End Sub
以上となります、何卒宜しくお願いします。
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
