名前を付けて保存時のファイル名の指定
- Access2010のフォームを使用してテーブルのデータを保存する際に、ファイル名を指定する方法について教えてください。
- 標準Module1内のGetFileName関数を使用して、保存のダイアログを表示し、ファイル名を取得します。
- ファイル名は「表示材料_現在の日付」という形式で自動的に表示させることができます。
- ベストアンサー
名前を付けて保存時のファイル名の指定
ボタンを押すとテーブルのデータが出力できるようにしたいと思います。 標準Module1とFormのボタンには下記のような記述をしていますが 添付ファイルのように保存のダイアログまではうまく動いているようです。 ただ、ファイル名がブランクですので、"表示材料_" & Format(Now(), "yyyymmdd")と自動的に表示させたいです。 ご教授お願いいたします。 【PC環境】 Access:2010 WIndows 7 【標準Module1】 Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _ strTitle As String) As String Dim returnValue As Integer Dim strFilePath As String If strFilter = "" Then strFilter = "全てのファイル (*.*)|*.*" End If WizHook.Key = 51488399 'WIZHOOK有効 returnValue = WizHook.GetFileName( _ 0, "", strTitle, "", strFilePath, "", _ strFilter, _ 0, 0, 0, OpenOrSaveFlg _ ) WizHook.Key = 0 ' WizHook 無効 GetFileName = strFilePath End Function 【Fromのボタン】 Private Sub コマンド28_Click() Dim strFileName As String Dim ExpFileName As String ExpFileName = "表示材料_" & Format(Now(), "yyyymmdd") strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "") If Len(strFileName) = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルが押されました。" Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "T_WO_MAT", "", True, "" End If End Sub
- aoaoaoki
- お礼率38% (25/65)
- Visual Basic
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
WizHook.GetFileNameの引数「strFilePath」に表示させたいパスをセットすればOKでは？ なので、 Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _ strTitle As String, strDefaultPath As String) As String みたいにして、 Dim strFilePath As String strFilePath = strDefaultPath とすればいけそうですが・・・ strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", "C:\Test.xls") みたいにしてコール。
関連するQ&A
- A1セル入力値をファイル名先頭に追加したい。
マクロ初心者で色々な事例を組み合わせて次のマクロを 作成しました。 A.xlsを開いて一部加工したファイルをB.xlsで保存し さらに一部を消去しC.xlsで保存するマクロです。 今回、B.xlsおよびC.xlsの先頭にA.xlsのA1セルに入力 された６桁の数字を付加して保存したいのですが・・・。 例えばA1セルが123456の時は 123456B.xls 123456C.xls どなたか教えてください。 現在のマクロ Sub Macro2() Dim strFilePath As String Dim strFileName As String Dim flg As Boolean '◆保存するパスの設定 strFilePath = ThisWorkbook.Path & "\" '◆保存するファイル名の指定 strFileName = "B" On Error Resume Next Workbooks(strFileName).Activate ThisWorkbook.SaveAs strFilePath & strFileName '◆個人情報消去 Range("D42:E49").Select Selection.ClearContents Range("d1").Select strFileName = "C" ThisWorkbook.SaveAs strFilePath & strFileName Application.Quit End Sub
- ベストアンサー
- Visual Basic
- 同じフォルダーに保存したい。
報告書.xlsを一部加工後に実行するVBマクロで教えてください。同じフォルダー内で報告書.xlsを上書き保存しさらに４個のsheet(報告書、詳細、依頼書、関連写真)の内、２個のsheet(依頼書、関連写真)を削除した後にsheet(報告書)のセル"Z1"の名前で保存すべく作成したのですが(Z1).xlsが同じフォルダーに作成できません。マイドキュメントに出来てしまいます。 Sub Macro2() Dim strFilePath As String Dim strFileName As String Dim flg As Boolean '◆保存するパスの設定 strFilePath = ThisWorkbook.Path & "\" '◆保存するファイル名の指定 Application.DisplayAlerts = False strFileName = "報告書" ThisWorkbook.SaveAs strFilePath & strFileName Sheets("関連写真").Select ActiveWindow.SelectedSheets.Delete Sheets("依頼書").Select ActiveWindow.SelectedSheets.Delete Sheets("報告書").Select strFilePath = ThisWorkbook.Path & "\" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ActiveSheet.Range("z1").Value End Sub
- ベストアンサー
- Visual Basic
- Access VBA
AccessからVBAを利用してダイアログ形式でExcelファイルのインポートをしたいです。 実行すると、 「このアクションまたはメソッドを実行するには、[File Name/ファイル名]引数が必要です。」 とエラーが出てしまいます。 標準モジュール —――――――――――――――――――――――――――――――――――― Function TestGetFileName() Const ENABLE_WIZHOOK = 51488399 Const DISABLE_WIZHOOK = 0 Dim strFile As String Dim intResult As Integer WizHook.Key = ENABLE_WIZHOOK ' WizHook 有効化 intResult = WizHook.GetFileName( _ 0, "", "", "", strFile, "", _ "xlsxファイル (*.xlsx)|*.*", _ 0, 0, 0, True _ ) WizHook.Key = DISABLE_WIZHOOK ' WizHook 無効化 TestGetFileName = strFile End Function —――――――――――――――――――――――――――――――――――― フォームのボタン押下時 —――――――――――――――――――――――――――――――――――― Public Sub コマンド0_Click() Dim s As String s = TestGetFileName If s = "" Or IsNull(s) Then Exit Sub DoCmd.TransferSpreadsheet acimport, 10, "取込B", strFileName, False, "注文TB!" MsgBox "インポートが終了しました。" End Sub —――――――――――――――――――――――――――――――――――― VBA自体かなりの初心者ですが、お知恵をお貸しください。
- ベストアンサー
- オフィス系ソフト
- Wordテンプレート一括変更でのサブフォルダ検索
ワードに使用されているテンプレートを一括でnormalに戻したいと考えています。 テンプレートを使用したファイルは、かなりの量があるため、Microsoftが公開している方法を用いて一括変更を試みましが、この方法では、1個づつフォルダを指定する必要があります。 そこで、指定したフォルダから下のサブフォルダも含めて変更できるようにするには、どのようにコードを書き換えればよろしいでしょうか？ コードは、ワードのVBEに貼り付けて実行しています。 よろしくお願いいたします。 Dim strFilePath As String Dim strPath As String Dim intCounter As Integer Dim strFileName As String Dim OldServer As String Dim objDoc As Document Dim objTemplate As Template Dim dlgTemplate As Dialog Dim nServer As Integer OldServer = "enter the name of the Old Server" nServer = Len(OldServer) strFilePath = InputBox("What is the folder location that you want to use?") If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\" strFileName = Dir(strFilePath & "*.doc") Do While strFileName <> "" Set objDoc = Documents.Open(strFilePath & strFileName) Set objTemplate = objDoc.AttachedTemplate Set dlgTemplate = Dialogs(wdDialogToolsTemplates) strPath = dlgTemplate.Template If LCase(Left(strPath, nServer)) = LCase(OldServer) Then objDoc.AttachedTemplate = NormalTemplate End If strFileName = Dir() objDoc.Save objDoc.Close Loop Set objDoc = Nothing Set objTemplate = Nothing Set dlgTemplate = Nothing
- 締切済み
- Visual Basic
- VBAのキャンセル処理
下記のVBAでファイルを出力することはできるようになったのですが、 出力するときに[キャンセル]を押しても"MsgBox ：Excelファイルへの出力が完了しました。"が表示されてしまいます。 「キャンセル」した場合は、このメッセージが表示されないようにできないでしょうか？ Private Sub Image_Export_Click() On Error GoTo Err_FileDialog_Click 'ファイル出力 Dim strFileName As String Dim ExpFileName As String ExpFileName = "T_master_" & Format(Now(), "yyyymmdd") strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls") If Len(strFileName) = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルが押されました。" Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_master", strFileName & ".xls", True End If MsgBox "Excelファイルへの出力が完了しました。", , "出力完了" Exit_FileDialog_Click: Exit Sub Err_FileDialog_Click: MsgBox "予期せぬエラーが発生しました" & Chr(13) & _ "エラーナンバー：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbOKOnly End Resume Exit_FileDialog_Click End Sub
- ベストアンサー
- Visual Basic
- ファイルの別名保存の方法
こんにちは。 Excelの素人です。blg.を参考に、ファイルの別名保存ボタンを作りましたが、別名保存後うまく終了してくれません。 現象は終了マクロから名前をつけて保存してもファイルが終了しません。もう一度ボタンをクリックするといきなり終了します。 素人の悲しさで、どこを修正すればよいのか悩んでいます。 Sub 別名保存後終了() If ThisWorkbook.Saved = False Then strFilename = ThisWorkbook.Path & "\" & _ "データ作成" & "_" & _ Format(Date, "yyyymmdd") & ".xls" strFilename = Application.GetSaveAsFilename( _ FileFilter:="Excelファイル,*.xls", _ InitialFileName:=strFilename, _ Title:="Excelファイルの保存") If strFilename = "False" Then If MsgBox("保存せずに終了します。よろしいですか？", _ vbOKCancel + vbInformation, _ "終了確認") = vbOK Then ThisWorkbook.Saved = True ThisWorkbook.Close Else Exit Sub End If Else ActiveWorkbook.SaveAs strFilename End If Else ThisWorkbook.Close End If End Sub 宜しくお願いします。
- ベストアンサー
- Visual Basic
- ＶＢからＥｘｃｅｌのテキストを指定して開きたい
ＶＢのアプリケーションから文書名を指定してエクセルを起動したいのですが 出来なくて困っています。ちなみにコードは下記のとおりです。どこに問題があ るのか教えていただけないでしょうか。 Private Sub Command1_Click() Dim lngReturnCode As Long Dim strFileName As String strFileName = "AllTitles.csv" lngReturnCode = ShellExecute(Me.hwnd, _ "open c:\***\***.xls", _ strFileName, _ vbNullString, _ App.Path, _ SW_SHOWNORMAL) End Sub
- ベストアンサー
- Visual Basic
- 他のブックに現在のデータを日付をつけて保存したい
WinXP Excel2003でマクロを作っている超初心者です。90％完成しましたが、次のことで止まっています。 1）Aブックのユーザーホームに、ＢコマンドボタンとＣコマンドボタンがあります。 Aブック→Ｂコマンドボタン→Ｂブック開く→入力→Ａブックのコマンドボタンで保存 →Ｃコマンドボタン→Ｃブック開く→入力→Ａブックのコマンドボタンで保存 2）Ａブックのコマンドボタンからではなく、エクセルを起動し、Ｂブックを開き、「今日の日付をつけて新規ブックに保存」のマクロを作りました。 コードは次のとおりでした。 Sub ブック名に現在の日付を付加して保存GH() 'Windows環境なのでEnviron関数を使ってみる Dim strFileName As String Dim strSavePath As String Dim intRe As Integer Application.DisplayAlerts = False ActiveWorkbook.Save strSavePath = Environ("HOMEPATH") strSavePath = strSavePath & "\デスクトップ\総務\請求\データ保存用" If Dir(strSavePath, vbDirectory) = "" Then MkDir (strSavePath) End If strFileName = strSavePath & "\ＧＨ請求" & Format(Date, "yyyymmdd") & ".xls" If Dir(strFileName) <> "" Then MsgBox "このＧＨ請求書を保存し、同時に「データ保存用」の中にも保存しました。。" Else ThisWorkbook.SaveAs Filename:=strFileName End If If intRe = vbNo Then Exit Sub If intRe = vbYes Then ActiveWorkbook.SaveAs Filename:=strFileName End If Application.DisplayAlerts = True Application.Quit End Sub 無事に今日の日付でＢブックが保存できました。 3）今度は、Ａブックから、→Ｂコマンドボタン→Ｂブック開く→Ａブックのコマンドボタンで「今日の日付をつけて新規ブックに保存」のマクロを実行しました。すると、保存先にはＡブックが保存されていました。ＡブックでなくＢブックのデータを保存したいのに・・・。 4）なぜ、Ｂブックが保存されないのでしょうか？ Ｂブックを保存するにはどうしたらよろしいでしょうか。
- 締切済み
- Visual Basic
- 複数のエクセルシートをまとめるマクロ
下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub
- ベストアンサー
- Excel（エクセル）
- VBAの実行時エラー'2522'について
前任者がAccess2003により作成したデータベースがあります。 CSVデータを取り込む仕組みがあるのですが、下記のエラーが出て困っています。 実行時エラー '2522': このアクションまたはメソッドを実行するには[File Name/ファイル名]引数が必要です。 どうやらVBAによるエラーだと判明しましたが、それ以上はよくわかりません。 以下のような構文になっています。 Option Compare Database ---------- Private Sub CSV取込_Click() TextConv strFileName, "マスター定義", "T_マスター" End Sub ---------- Sub TextConv(strFle, strInp, strTbl) Dim strSQL As String strSQL = "DELETE * FROM " & strTbl If MsgBox("テーブルデータを更新しますか？", 4, "テーブル更新") = vbYes Then CurrentProject.Connection.Execute strSQL DoCmd.TransferText acImportDelim, strInp, strTbl, strFle, True MsgBox "テーブルデータを更新しました" End If End Sub ---------- Private Sub 参照_Click() Dim strFileName As String strFileName = GetFileName() If Len(strFileName) > 0 Then Me.filepath = strFileName Else MsgBox "取込対象ファイルを選択してください！ " End If End Sub 以上のようになっています。 デバッグを実行すると「strFle」の値がEmptyになっているのでここだとは思うのですが、どうしたらよいかわかりません。 どなたかお知恵をお貸し願えませんでしょうか。 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
BarcodMasterさん ありがとうございます。 想像通りに動きました。 【標準Module1】 Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _ strTitle As String, strDefaultPath As String) As String Dim returnValue As Integer Dim strFilePath As String strFilePath = strDefaultPath If strFilter = "" Then strFilter = "全てのファイル (*.*)|*.*" End If WizHook.Key = 51488399 'WIZHOOK有効 returnValue = WizHook.GetFileName( _ 0, "", strTitle, "", strFilePath, "", _ strFilter, _ 0, 0, 0, OpenOrSaveFlg _ ) WizHook.Key = 0 ' WizHook 無効 GetFileName = strFilePath End Function 【Fromのボタン】 Private Sub コマンド28_Click() Dim strFileName As String Dim ExpFileName As String ExpFileName = "表示材料_" & Format(Now(), "yyyymmdd") strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls") If Len(strFileName) = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルが押されました。" Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_WO_MAT", strFileName & ".xls", True End If End Sub