[[20110222070338]]　『ファイル名が一致したらフォルダ移動』（みち）　ページの最後に飛ぶ

『ファイル名が一致したらフォルダ移動』（みち）

Aというフォルダに数百のエクセルファイルがあります。
その中から、ファイル名が入ったエクセルリストと一致するものだけを
Bのフォルダに移したいのです。コピーでもかまいません。

毎回これを手作業でやっているので、何か方法はないでしょうか？

WindowsVista
Excel2003

 ファイル名は拡張子まで含めて正しく入力されているでしょうか。
 ファイル名のリスト形式（セル位置）を提示してもらえると、解答しやすいと思い 
 ます。
 バッチでもできますし、マクロでもできますが、リストファイルというのは毎回
 変わるのでしょうか。
 また、Aというフォルダと、リストのあるファイルのフォルダは別ですか？
 (Mook)

ファイル名は拡張子までは入っていません。
またリストファイルは毎回変わります。
リストは1ファイルで、sheet1の中にフォルダを移動したい対象のリストが入っています。

ファイル名のリスト形式（セル位置）を提示、とはどういうことでしょうか？すみません、理解できません。

 A フォルダは固定でしょうか。
 リストファイルは毎回変わるということですね。
 セル位置 というのは、「リストがSheet1 の A列にある」という情報のことです。
 マクロは利用可能ですか？
 (Mook)

 A フォルダは固定です。
 リストファイルは毎回変わります。
 セル位置 は、リストがSheet1 の A列にあります。
 マクロは利用可能です。

 マクロの例です。
 移動元と移動先のフォルダは実際に併せてください。

 Sub CheckAndMoveFiles()
    Const FolderA = "C:\Data\A"
    Const FolderB = "C:\Data\B"

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    Dim r As Long
    Dim fileName As String
    For r = 1 To lastRow
        If ws.Cells(r, "A").Value <> "" Then
            fileName = ws.Cells(r, "A").Value & ".xls"
            If fso.FileExists(FolderA & "\" & fileName) = True Then
                fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName
            End If
        End If
    Next
 End Sub
 (Mook)

ありがとうございます。
無事できました。

上記では、ファイル名とリストファイルの内容が完全一致したものでしたが、ファイル名の頭6文字とリストファイルをマッチングさせることは可能でしょうか。

ファイル名：A00001-検査、A00002-表、A00003-検査表･･･
リスト：A00002、A00003･･･

ファイル名の頭6文字はちゃんと入っているのですが、途中からまちまちな入力のされ方をしているので、一致したと見なされずフォルダ移動しないのです。

名前を入れ忘れました。みちです。

上記では、ファイル名とリストファイルの内容が完全一致したものでしたが、ファイル名の頭6文字とリストファイルをマッチングさせることは可能でしょうか。
ファイル名：A00001-検査、A00002-表、A00003-検査表･･･リスト：A00002、A00003･･･

 現在はA列を上から順番に、
            If fso.FileExists(FolderA & "\" & fileName) = True Then
 でファイルがあるかの確認をしていますが、fso はワイルドカードは使えません。
 Dir 関数はワイルドカードが使えるので、上記の部分を
     dFileName = Dir(  FolderA & "\" & left(filename,6)  & "*.xls")
     Do While dFileName <> ""
        移動処理
        dFileName = Dir()
     Loop
 のように書きかえれば対応可能でしょう。
 下記、ご参考まで。
http://officetanaka.net/excel/vba/tips/tips95.htm
 (Mook)

 あけみさん、回答者のみなさん、おはようございます。

 回答者への参考として一応リンクしておきます。

http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=143406&rev=0

 (マチルダ)

みちです。

それって、

Sub CheckAndMoveFiles()

    Const FolderA = "C:\Data\A"
    Const FolderB = "C:\Data\B"

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    Dim r As Long
    Dim fileName As String
    For r = 1 To lastRow
        If ws.Cells(r, "A").Value <> "" Then
            fileName = ws.Cells(r, "A").Value & ".xls"

     dFileName = Dir(FolderA & "\" & Left(fileName, 6) & "*.xls")
     Do While dFileName <> ""
        移動処理
        dFileName = Dir()
     Loop

                fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName
            End If
        End If
    Next
 End Sub

でいいってことでしょうか？

コメント返信：

[ 一覧(最新更新順) ]

[[20110222070338]] 『ファイル名が一致したらフォルダ移動』（みち） ページの最後に飛ぶ

[[20110222070338]]　『ファイル名が一致したらフォルダ移動』（みち）　ページの最後に飛ぶ