Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

908 / 9994

←次へ　｜　前へ→


	【12393】インポートしたファイルのファイル名取得

中村 - 13/7/18(木) 13:33 -


	引用なし

	パスワード

いつもお世話になっております。

現在、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

以上となります、何卒宜しくお願いします。

1,757 hits

▼

【12393】インポートしたファイルのファイル名取得 中村 13/7/18(木) 13:33