Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6239 / 76734 ←次へ | 前へ→

【76097】Re:ファイル名に指定された文字が含まれるファイルを集約したい
発言  kanabun  - 14/9/24(水) 14:26 -

引用なし
パスワード
   なんだか 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

2 hits

【76091】ファイル名に指定された文字が含まれるファイルを集約したい ペンネーム船長 14/9/23(火) 11:32 質問
【76092】Re:ファイル名に指定された文字が含まれる... カリーニン 14/9/23(火) 18:14 発言
【76093】Re:ファイル名に指定された文字が含まれる... カリーニン 14/9/23(火) 18:18 発言
【76095】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 12:08 発言
【76097】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 14:26 発言
【76100】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 16:56 発言
【76103】Re:ファイル名に指定された文字が含まれる... ペンネーム船長 14/9/26(金) 0:50 お礼
【76104】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/26(金) 1:16 発言

6239 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free