VBA でメモ帳へ保存する際の保存先フォルダの指定

お世話になります。
エクセルで作成したデータをメモ帳で保存したいのですが
ファイル名は作成者が任意で決め、保存先アドレスをあらかじめ指定しておくにはどうしたら良いでしょうか。
ネットで下記のように色々探したのですが
ファイル名は決めることが出来ても保存先が指定出来なかったり、
その逆だったりとなかなか上手くいきません。
ご教示よろしくお願い致します。


Option Explicit

' テキストファイル書き出すサンプル
Sub WRITE_TextFile()
Const cnsTitle = "テキストファイル出力処理"
Const cnsFilter = "テキストファイル (*.txt;*.dat),*.txt;*.dat"
Dim xlAPP As Application ' Applicationオブジェクト
Dim intFF As Integer ' FreeFile値
Dim strFileName As String ' OPENするファイル名(フルパス)
Dim vntFileName As Variant ' ファイル名受取り用
Dim strREC As String ' 書き出すレコード内容
Dim GYO As Long ' 収容するセルの行
Dim GYOMAX As Long ' データが収容された最終行
Dim lngREC As Long ' レコード件数カウンタ

' Applicationオブジェクト取得
Set xlAPP = Application
' ｢名前を付けて保存｣のフォームでファイル名の指定を受ける
xlAPP.StatusBar = "出力するファイル名を指定して下さい。" ' ①
vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _
FileFilter:=cnsFilter, _
Title:=cnsTitle)
' キャンセルされた場合はFalseが返るので以降の処理は行なわない
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName

' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
With ActiveSheet
If .FilterMode Then .ShowAllData ' オートフィルタ解除
End With
GYOMAX = Cells(65536, 1).End(xlUp).Row ' ②
If GYOMAX < 2 Then
xlAPP.StatusBar = False
MsgBox "テキストをA列2行目から入力してから起動して下さい。", , cnsTitle
Exit Sub
End If

' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(出力モード)
Open strFileName For Output As #intFF ' ③
' 2行目から開始
GYO = 2
' 最終行まで繰り返す
Do Until GYO > GYOMAX
' A列内容をレコードにセット(先頭は2行目)
strREC = Cells(GYO, 1).Value ' ④
' レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "出力中です．．．．(" & lngREC & "レコード目)"
' レコードを出力
Print #intFF, strREC ' ⑤
' 行を加算
GYO = GYO + 1
Loop
' 指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False
' 終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & lngREC & "件", vbInformation, cnsTitle
End Sub

No.1 ベストアンサー 回答者： tatsu99 回答日時： 2018/02/22 00:04

以下のようにしては、どうでしょうか。

Sub WRITE_TextFile()　へ
①
Const cnsFolder = "d:\sample\foldername"・・・この行を追加　格納フォルダ名(d:\sample\samplefoldernameへ格納する場合)
②
vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _・・・を
vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:=cnsFolder, _・・・に変更

この回答へのお礼

すごく助かりました！
ありがとうございました！

お礼日時：2018/02/22 13:18

No.2 回答者： WindFaller 回答日時： 2018/02/22 11:08

こんにちは。

このような書き方をするのは、Excelでお仕事の井上さんのもののようです。
質問で全文のコードを載せる場合は、マナーとして引用先は書いた方がよいですね。

それと、ご質問内容とコードは一致していないようです。
フォルダーは決めておいて、名前をつけないままのメモ帳を出したいというと、コードがまったく違ってきます。
たぶん、一般的にはどこにも出ていないはずです。そんな特殊なコードを書く人は、本当にマレです。

>エクセルで作成したデータをメモ帳で保存したいのですが
元のコードは、一列のみのようですが、それでよいのでしょうか？

一応、現在のものを活かすなら、
>ファイル名は作成者が任意で決め、保存先アドレスをあらかじめ指定しておくにはどうしたら良いでしょうか。
それに、保存先のフォルダーを先に与えて置けばよいだけですが。

'任意の場所↓（ご自身でて書き換えてください)OneDriveに指定しています。
mPath ="C:\Users\" & Environ("UserName") & "\OneDrive\ドキュメント\"
strFileName = mPath & strFileName
-----------------------------------
>FreeFile値の取得(以降この値で入出力する)
>intFF = FreeFile
>' 指定ファイルをOPEN(出力モード)
>Open strFileName For Output As #intFF ' ③

この回答へのお礼

ありがとうございました。
どうやら失礼なことをしてしまったようで
今後気をつけます。

お礼日時：2018/02/22 13:20