| |
なんだか FSOで CopyFile すると思いっきり時間がかかるので、
Dirコマンドでファイル名取得して、
VBA組み込みの FileCopy ステートメントでCopyしたほうが多少早いかも？
Sub Try2()
Dim fData
Dim i&, j&
Dim n&
Dim ss$
Const TOP_FOLDER = "C:\Test1"
Const COPY_TO = "C:\Test2"
n = FileSearch(TOP_FOLDER & "\*おはよう*.xlsx", fData)
If n = 0 Then Exit Sub
For i = 1 To n
j = InStrRev(fData(i), "\")
FileCopy fData(i), COPY_TO & Mid$(fData(i), j)
Next
End Sub
Private Function FileSearch(PathFilename As String, fData) As Long
Dim tmpPath As String
Dim sCmd As String
Dim ok As Long
tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス
sCmd = "DIR """ & PathFilename & """ /s /b > """ & tmpPath & """"
ok = CreateObject("WScript.Shell") _
.Run("%ComSpec% /C " & sCmd, 7, True) 'Dirコマンド実行
If FileLen(tmpPath) > 0 Then
Dim buf() As Byte
Dim io As Integer
io = FreeFile()
Open tmpPath For Binary As io
ReDim buf(1 To LOF(io))
Get io, , buf
Close io
Kill tmpPath
fData = Split(vbCrLf & StrConv(buf, vbUnicode), vbCrLf)
FileSearch = UBound(fData) - 1
End If
End Function
|
|
kanabun
- 14/9/24(水) 14:26 -
