エクセルマクロ 指定したフォルダ内のファイルをコピーしたい

質問

エクセルのセルに入力されたフォルダを参照して、
wordファイルを別のフォルダにコピーするようなマクロがあれば、
ぜひ教えてください。

・A1には、="パス名"&A2　と元々入力してあり、
　A2には実行する前に"dd.mm"と入力。
・このdd.mmフォルダから、yyyyフォルダに*.docをコピー。

A1セルを参照する方法がわかればいいのですが、何分初心者なもので
ご指導いただければと思います。

回答No.2

kuma3f · ベストアンサー

次のような方法はいかがでしょうか。
マクロにコードを記述して実行します。

Ａ２、Ｂ２のセルを選択して右クリック
　↓
「セルの書式設定」をクリック
　↓
「表示形式」で「文字列」を選択し「ＯＫ」をクリック
（フォルダ名が月日になると思われるので02.09だと
2.09になってしまうためです。）
　↓
Ａ１に「="パス名"&A2」、Ａ２に「mm.dd」、
Ｂ１に「="パス名"&B2」、Ｂ２に「yyyy」を入力
（※パス名はの後ろには必ず\を付けてください。
　　例：C:\TEST\　）
　↓
メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
マクロのダイアログが表示されたらマクロ名に
自由に名前を入力してください。（例：WORDCOPY）
　↓
名前を入力しましたら、「作成」をクリック
　↓
Microsoft Visual Basicの画面が開きますので
Sub WORDCOPY()の下に次のコードをコピーして
貼り付けてください。

Dim ファイル名 As String 'ファイル名
Dim パス名1 As String 'コピー元パス名
Dim パス名2 As String 'コピー先パス名
パス名1 = Range("A1") & "\" ' パスを設定します。
パス名2 = Range("B1") & "\" ' パスを設定します。
ファイル名 = Dir(パス名1 & "*.doc") ' ←最初のファイル名を返します。
Do While ファイル名 <> "" ' ←ファイル名を全て見るまで繰り返す
FileCopy パス名1 & ファイル名, パス名2 & ファイル名 '←ファイルのコピー
ファイル名 = Dir ' ←次のファイル名を返します。
Loop
Range("A1").Select
MsgBox "コピーしました。"
'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
　↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
先ほど付けたマクロを選択して「実行」をクリック
　↓
dd.mmフォルダから、yyyyフォルダに*.docがコピーされていると思います。

お礼

ご丁寧な回答ありがとうございます！
こちらの方法で、めでたく解決しました。
本当にありがとうございました。

回答No.3

Wendy02

こんばんは。

>・このdd.mmフォルダから、yyyyフォルダに*.docをコピー。
dd.mm =A2 が、「送り元」で、A1=yyyy が「送り先」ですか？
その順番は、必ず確認してくださいね。

エラーチェックをいくつか施しました。

以下は、なるべく、標準モジュールに設定してください。

Sub TestMacro1()
　　Dim srcFolder As String
　　Dim dstFolder As String
　　'フォルダ名チェック
　　'送り先
　　dstFolder = Range("A2").Value
　　If Right(dstFolder, 1) <> "\" Then dstFolder = dstFolder & "\"

　　'送り元
　　srcFolder = Range("A1").Value
　　If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"

　　If srcFolder = "" Or dstFolder = "" Then Exit Sub

　　'ディレクトリチェック
　　If Dir(srcFolder, vbDirectory) = "" Then
　　　　MsgBox srcFolder & " が見つかりません", 48
　　　　Exit Sub
　　End If
　　If Dir(dstFolder, vbDirectory) = "" Then
　　　　MsgBox dstFolder & " が見つかりません", 48
　　　　Exit Sub
　　End If
　　If Dir(srcFolder & "*.doc") = "" Then
　　　 MsgBox "送り元には、Wordドュキメントがありません。", 48
　　　 Exit Sub
　　End If

　　With CreateObject("Scripting.FilesystemObject")
　　　　.Copyfile srcFolder & "*.doc", dstFolder
　　End With
End Sub

お礼

ご回答ありがとうございます！
こちらの方法でも私のやりたいことができ、1つの問題に対して
複数の方法があるのだと実感しました。
これかも勉強していきたいと思います。
ありがとうございました。

回答No.1

coral_japan

あらかじめ、フォルダは作成してあるものとして。
yyyyフォルダは仮にC:\yyyyとしてあります。
-----------------
Sub FolderCopy()
'A1 を取得します
OrgFolder = Range("A1")
'Copy先 をセットします
CopyFolder = "C:\yyyy"
'フォルダオブジェクトを取得
Set SourcFolder_Object = CreateObject _
("Scripting.FileSystemObject").GetFolder(OrgFolder)
'OrgFolder内の全ファイルをCopy先にコピー
'サブフォルダも対象になります
SourcFolder_Object.Copy CopyFolder
MsgBox "完了しました"
End Sub

お礼

ご回答、ありがとうございます！
さっそく試してみたところ、yyyyフォルダ内に新たにA1のフォルダコピーが作成されました。
ファイルだけをコピーすることはできないでしょうか・・・？

よろしくお願いします！