フォルダのアドレスと選択したファイル名のコピー

質問

フォルダのアドレスと、そのフォルダ内で選択されているファイルのファイル名を
一括でコピーする方法はありますでしょうか。

画像のような状態で何か操作することで
下記のように保存先とファイル名をコピーできるようにしたいです。
---------------------------------
\\ああああ\いいいい\・テスト
テキスト.txt
---------------------------------
※「 テキスト.txt　」ファイルは開いていない状態です。

エクセルを立ち上げている状態ならVBAを使えばコピーできる　　など
何か方法が無いかお知恵頂きたいです。

何卒宜しくお願い致します。

回答No.2

notnot · ベストアンサー

画面からしてXPのようなので、下記をfoo.vbsという名前のファイルで作って、ファイルをドロップするか、SendToフォルダに入れて右クリックで「送る」かすると、クリップボードにコピーされます。
Officeがインストールされていることが前提。

Set uf=CreateObject("Forms.Form.1")
Set tb=uf.Controls.Add("Forms.TextBox.1").Object
Set Args = WScript.Arguments
if Args.Count > 0 then
pos=instrrev(Args(0),"\")
tb.Text=left(Args(0),pos-1)&vbCRLF&mid(Args(0),pos+1)
tb.MultiLine=True
tb.SelStart=0
tb.SelLength=tb.TextLength
tb.Copy
end if

お礼

ありがとうございました！！

社内メールで頻繁に「保存場所・名前」を送る機会があり、
かなり作業の効率化ができました！！！！
同僚にも共有したところ、同僚もまた驚いておりました。

本当にありがとうございます！！

補足

ご回答ありがとうございます！
コードもご丁寧に全て記載頂きありがとうございます。

vbsという形式のファイルは初めて作成しました。
ファイルをドロップすると、まさに保存先とファイル名がコピーされて
とっっっっても驚きました！！！！！！凄いですね、、、、、。

>SendToフォルダに入れて右クリックで「送る」
こちらは私には理解できず、申し訳ありません、、、。

本当にありがとうございます！！！！

回答No.1

hallo-2007

エクセルのVBAでよろしいですよね
A1セルにファイル名が必要なパスをしているとします。

Sub Sample1()
Dim buf As String, i As Long
Dim j As Long
buf = Dir(Range("A1").Value & "\*.*")
Do While buf <> ""
i = i + 1
ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value = buf
buf = Dir()
Loop
End Sub

をエクセルで実行してみてください。

お礼

回答をくださったのに、私の知識不足で正常に動作させることができず、
申し訳ありません。。。。

ありがとうございました！！！

補足

ご回答ありがとうございます！
また、コードもご丁寧にありがとうございます！！
返事が遅くなり大変申し訳ありません。

頂いたコードを記載して、実行してみたのですが、
以下の文字がエクセルに表示されます。
-------------------
AUTOEXEC.BAT
CONFIG.SYS
-------------------

フォルダを開いて、ファイルを選択した状態にしてから
実行したのですが、、、、。

私の記載の仕方が間違っていると思うのですが、どこが間違っているのかが
判断できず。。。お時間ございましたら作成したファイルを見て頂けると
幸いでございます。

写させて頂いたコードを記載したファイルを下記にアップ致しました。
--------------------------------------------------------------------
http://firestorage.jp/download/3b71fdb265e87d4df019b22df27f754f70cdfd6e
--------------------------------------------------------------------

何卒宜しくお願い致します。