|
これは上司から作ってくれといわれているんですが、まだそのコピーするファイルのリストが届いてないんです。で、多分そのリストが届いたらそこにフォルダ名も書いてあると思うんです。
だから多分検索場所を少しは絞り込めるとは思うんですが・・・。
↓は僕なりに色々と考えて作ったんです。
シートのA列にコピーするファイルをすべて入力する予定です。
多分↓を見ると僕がしたいことを分かってもらえると思うのですが。
Sub aaa()
On Err GoTo エラー
Dim a As Integer
Dim b As String
Dim c As String
Range("a1").Select
a = 1
Application.Cursor = xlWait
MkDir "c:\コピー先"
Do
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.SearchSubFolders = True
.Filename = ActiveCell
.FileType = ここが分かりません
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
b = .FoundFiles(i)
c = "c:\コピー先\" + ActiveCell
FileCopy b, c
Next i
Else
MsgBox "ファイルがありません。( & activecell.value & )"
End If
End With
ActiveCell.Offset(1, 0).Select
a = a + 1
Loop Until a = 18000
Application.Cursor = xlDefault
Exit Sub
エラー:
MsgBox "エラーが発生しました"
End Sub
filetypeさえできれば多分いくと思うんですが。
|
|