VBAでファイル名を指定して保存するとき

エクセルVBAでApplication.Dialogsを使用して保存した後、選択したフォルダを変数に持たせることは可能でしょうか。

予めフォルダを選択するやり方も知っているのですが、ファイル名を固定で持たせ、かつ、パスワード設定なども一緒に設定したくて、Application.Dialogsを選択しました。
次に保存するときに同じフォルダを参照先に持たせたいです。


Function FileSave(Extention As String, DialogNum As Integer)
Dim FileName As String
Dim Done As Variant

FileName = "Test" & "_" & Format(Now(), "YYYYMMDDHHMMDDSS")

IF Activesheet.Cells(1,1) = ”” Then
SavePath = ThisWorkbook.Path
Else
SavePath = Activesheet.Cells(1,1)
EndIF

Done = IIf(Application.Dialogs(xlDialogSaveAs).Show(Arg1:=SavePath & "\" & FileName & Extention, Arg2:=DialogNum, Arg3:=Password), "保存", "キャンセル")

'ここに選択したフォルダのパスを入れたい
Activesheet.Cells(1,1) = "直前で選択したフォルダのパス"

End Function

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2023/03/26 22:58

こんばんは

＞予めフォルダを選択するやり方も知っているのですが、
ファイル名を固定で持たせ、かつ、パスワード設定なども一緒に設定したくて、Application.Dialogsを選択しました。
次に保存するときに同じフォルダを参照先に持たせたいです。

＞Done = IIf(Applicat・・　の戻り値は　"保存", "キャンセル"　なので
予めフォルダを選択するやり方でやる方法で良いと思うのですが
仕様に合っていなかったらごめんなさい

Function FileSave(Extention As String, DialogNum As Integer)
Dim SavePath As String
Dim FileName As String
Dim saveFileName As Variant
Dim myPassword As String
myPassword = ""
If ActiveSheet.Cells(1, 1) = "" Then
SavePath = ThisWorkbook.Path & "\"
Else
SavePath = ActiveSheet.Cells(1, 1) & "\"
End If

FileName = "Test" & "_" & Format(Now(), "YYYYMMDDHHMMDDSS")
saveFileName = Application.GetSaveAsFilename(InitialFileName:=SavePath & FileName)
If saveFileName = False Then
Exit Function
End If
ActiveWorkbook.SaveAs FileName
ActiveWorkbook.SaveAs _
FileName:=saveFileName & Extention, _
FileFormat:=DialogNum, _
Password:=myPassword, _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

saveFileName = Left(saveFileName, InStrRev(saveFileName, "\") - 1)
ActiveSheet.Cells(1, 1) = saveFileName
End Function

この回答へのお礼

回答いただきありがとうございます。
実行してみたところ思い通りの挙動になりました。
SaveAs に色々付け足せばいいんですね。なるほどです。
大変助かりました。

お礼日時：2023/03/26 23:08

No.4 回答者： Qchan1962 回答日時： 2023/03/26 23:04

ごめんなさい

FileFilterを書きませんでした　マクロ有効ブックを保存で良いかと・・・違うかもですが
saveFileName = Application.GetSaveAsFilename(InitialFileName:=SavePath & FileName, FileFilter:="Excelファイル,*.xlsm")

呼び出し
Call FileSave("xlsm", 52)

GetSaveAsFilename　戻り値に　.が付くのでxlsm かな

No.2 回答者： 河内のおやじ 回答日時： 2023/03/26 22:05

Function FileSave(Extention As String, DialogNum As Integer)

Dim FileName As String
Dim Done As Variant
Dim SavePath As String

FileName = "Test" & "_" & Format(Now(), "YYYYMMDDHHMMDDSS")

If ActiveSheet.Cells(1, 1) = "" Then
SavePath = ThisWorkbook.Path
Else
SavePath = ActiveSheet.Cells(1, 1)
End If

Done = IIf(Application.Dialogs(xlDialogSaveAs).Show(Arg1:=SavePath & "\" & FileName & Extention, Arg2:=DialogNum, Arg3:="Password"), "保存", "キャンセル")

'ファイルが保存された場合に、選択したフォルダのパスをセルに格納する
If Done = "保存" Then
SavePath = Left(Done, Len(Done) - Len(FileName & Extention)) 'ファイル名を取り除いたフォルダパスを取得
ActiveSheet.Cells(1, 1) = SavePath
End If

End Function

この回答へのお礼

回答いただきありがとうございます。
Done には”保存”または”キャンセル”の文字列が格納されるためパスの情報は持っていません。同様に書き換えましたが実行エラーになってしまいますね。

予めフォルダとファイル名、パスワードをフォームで選ばせる方法がベストな気がしてきました。

お礼日時：2023/03/26 22:26

No.1 回答者： 河内のおやじ 回答日時： 2023/03/26 22:04

はい、可能です。

Application.Dialogs(xlDialogSaveAs)を使用すると、保存ダイアログボックスが表示され、ユーザーが保存するフォルダとファイル名を選択できます。ダイアログボックスが閉じた後、選択されたフォルダのパスを取得し、変数に格納することができす。