|
こんにちは。かみちゃん です。
> これは上司から作ってくれといわれているんですが、まだそのコピーするファイ
> ルのリストが届いてないんです。で、多分そのリストが届いたらそこにフォルダ
> 名も書いてあると思うんです。
> だから多分検索場所を少しは絞り込めるとは思うんですが・・・。
>
>↓は僕なりに色々と考えて作ったんです。
>シートのA列にコピーするファイルをすべて入力する予定です。
それであれば、私だったら、以下のようなコードにします。
ファイル検索の部分は、ほとんど変えていません。
★の部分をよーく確認してください。前回とまったく変えていません。
Sub aaa2()
Dim strCopyPath As String
Dim c As Range
Dim LastCell As Range
On Err GoTo エラー
Application.Cursor = xlWait
strCopyPath = "c:\コピー先"
MkDir strCopyPath
Set LastCell = Cells(Rows.Count, 1).End(xlUp)
For Each c In Range("A1", LastCell)
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.SearchSubFolders = True
.Filename = c.Value
.FileType = msoFileTypeAllFiles '★
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
FileCopy .FoundFiles(i), strCopyPath & "\" + ActiveCell
Next i
Else
MsgBox "ファイルがありません。(" & c.Value & ")"
End If
End With
Next
Application.Cursor = xlDefault
Exit Sub
エラー:
MsgBox "エラーが発生しました"
End Sub
ただし!届く予定になっているリストがフォルダ名からのフルパスが書かれている
のであれば、このような回りくどいことをしなくてもいいですよ。
今回のサンプルは、あくまで、ファイル名だけ書かれていて、そのパスをひとつず
つ検索するパターンです。
ただし、C:\のサブフォルダに同じファイル名があれば、後から見つかったファイ
ルを上書きしますし、そもそも、C:\からサブフォルダまでひとつずつ繰り返して
検索するのか、想像以上に時間がかかると思います。
何がしたいのか、未だにさっぱりわかりませんが、処理の見直しをおすすめします。
|
|