Excel VBA質問箱 IV

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

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


67632 / 76732 ←次へ | 前へ→

【13654】Re:検索して一つのCSVファイルに・・・
回答  ちゃっぴ E-MAIL  - 04/5/10(月) 17:48 -

引用なし
パスワード
   FileSearchオブジェクトDir関数はパス名が長いと正常に動作しない場合があるので、お勧めしません。
http://support.microsoft.com/default.aspxscid=kb;JA;213983&Product=xlw2kINT

FileSystemObjectをつかってみては?

以下サンプル
------------------------------------------------------------------
Option Compare Binary      'バイナリモードで比較

'フォルダパスを指定(任意に変えてください)
Private Const cstrFolederPath   As String = "c:\"
'検索ファイル名(任意に変えてください、ワイルドカード"*"使用可)
Private Const cstrSearchName   As String = "*.csv"
'出力CSVファイル名(任意に変えてください)
Private Const cstrOutPutName   As String = "MargeData.csv"

Private objFSO          As Object  'ファイルシステムオブジェクト
Private objOutPutFile      As Object  '出力先CSVファイル
Private strUSearchName      As String  '大文字変換後の検索ファイル名

'********************************************************
'呼び出し部分
'********************************************************
Sub CallMargeCSV()
  Dim objTargetFolder As Object
  
  strUSearchName = UCase(cstrSearchName)
  
  'ファイルシステムオブジェクト取得
  objFSO = CreateObject("Scripting.FileSystemObject")
  '指定のフォルダオブジェクト取得
  objTargetFolder = objFSO.GetFolder(cstrFolederPath)
  '出力CSVファイル作成
  objOutPutFile = objFSO.OpenTextFile(cstrOutPutName, ForAppending, True)
  
  'CSVマージ呼び出し
  Call MargeCSV(objTargetFolder)
  
  objOutPutFile.Close   '出力CSVファイル閉じる
  '変数初期化
  Set objOutPutFile = Nothing
  Set objTargetFolder = Nothing
  Set objFSO = Nothing
End Sub

'********************************************************
'本体CSVファイルを検索し、データをマージ(再帰処理)
'********************************************************
Sub MargeCSV(ByVal objTargetFolder As Object)
  Dim objTargetFile As Object
  Dim objTargetSubFolder As Object
  
  'フォルダ中のファイルを検索
  For Each objTargetFile In objTargetFolder.Files
    '検索結果にマッチした場合
    If UCase(objTargetFile.Name) Like strUSearchName Then
      'テキストストリームオブジェクトとして開く
      With objTargetFile.OpenAsTextStream
        '最終行までループ
        Do Until .AtEndOfStream = True
          'CSVデータの追記
          objOutPutFile.WriteLine = .ReadLine
        Loop
        .Close   'テキストストリームオブジェクトを閉じる
      End With
    End If
  Next objTargetFile
  Set objTargetFile = Nothing
  
  'サブフォルダに対し再帰呼び出し
  For Each objTargetSubFolder In objTargetFolder.SubFolders
    Call MargeCSV(objTargetSubFolder)
  Next objTargetFile
  Set objTargetSubFolder = Nothing
  
  Set objTargetFolder = Nothing
  
End Sub
------------------------------------------------------------------
こんな感じです。

FileSystemObjectを使用しているので遅いです。
速度を重視するのであればWIN32API(FindFirstFile)を使用するしかないでしょう。
2 hits

【13578】検索して一つのCSVファイルに・・・ Mino_Boo 04/5/8(土) 0:59 質問
【13611】Re:検索して一つのCSVファイルに・・・ Hirofumi 04/5/9(日) 17:37 回答
【13654】Re:検索して一つのCSVファイルに・・・ ちゃっぴ 04/5/10(月) 17:48 回答

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