Excel VBA質問箱 IV

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

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


6241 / 76734 ←次へ | 前へ→

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

引用なし
パスワード
   ▼ペンネーム船長 さん:
こんにちは〜

>やりたい事:各フォルダー(『A』『B』『C』・・・)の中のファイル名に『こんにちは』の文字の入ったエクセルをCドライブ直下のtest2にコピーしたい。
>
>  FSO.CopyFile "C:\test1\(フォルダー名)\*こんにちは*.xlsx", "C:\test2\"

一例ですが、
あるフォルダのなかにあるSubFolder は
Dirコマンドのオプションを指定すると取得できます。


'関数 DirFolder を呼び出し、SubFolderを取得し、
' イミディエイト・ウィンドウに表示する例
Sub Try1a()
 Dim fData
 Dim i&
 Dim n&
 
 n = DirFolder("C:\Test1", fData)
 If n = 0 Then Exit Sub
 For i = 1 To n
   Debug.Print i; fData(i)
 Next
End Sub

'関数 DirFolder を呼び出し、SubFolderを取得し、
'各サブフォルダ内の対象ファイルをコピーする例
Sub Try1b()
 Dim fData
 Dim i&
 Dim n&
 Dim Fso As Object
 Const TOP_FOLDER = "C:\Test1"
 Const COPY_TO = "C:\Test2"
 
 n = DirFolder(TOP_FOLDER, fData)
 If n = 0 Then Exit Sub
 
 Set Fso = CreateObject("Scripting.FileSystemObject")
 For i = 1 To n
   On Error Resume Next
   Fso.CopyFile fData(i) & "\*こんにちは*.xlsx", COPY_TO
   If Err().Number Then
     Debug.Print fData(i), Err().Description
     Err().Clear
   End If
   On Error GoTo 0
 Next
End Sub


'Dirコマンドのオプション
' /a:D フォルダ(Directory) 属性のみ検索
' /s SubDirも検索
' /b ファイル名のみ表示
Private Function DirFolder(Pathname As String, fData) As Long
  Dim tmpPath As String
  Dim sCmd As String
  Dim ok As Long
  
  tmpPath = Environ$("Temp") & "\Dir.tmp"  '一時ファイルパス
  sCmd = "DIR """ & Pathname & """ /a:D /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)
    DirFolder = UBound(fData) - 1
  Else
    DirFolder = 0
  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 発言

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