0

フォルダーを調べ、指定されたファイルを見つけて、セルのタイムスタンプを吐き出す簡単なスクリプトを作成しようとしています。それは私がすでに持っている簡単な部分です（文字列とオブジェクトを使用）。

私が問題を抱えている部分は、+1,000 ファイルのフォルダー内で 400 以上の特定のファイルを繰り返すことです。すべてのファイルに異なるラベルが付けられていますが、類似しているファイルもあります (AB.xls、AC.xls、AD.xls、A1.xls、A2.xls など)。長い道のりを歩んで、特定のファイルごとに文字列名を変更するだけで、洗い流して繰り返すことができますが、それでは書き込むのに時間がかかりすぎます。

これをループするショートカットはありますか、それともファイル名を毎回変更するために変数行を追加する必要がありますか?

ここにスニペットがあります：

Sub Timecheck() 
    Dim oFS As Object 
    Dim strFilename As String 

    strFilename = "Where the file is located" 
    Set oFS = CreateObject("Scripting.FileSystemObject") 
    Sheets("tab").Activate
    ActiveSheet.Cells(3, 3).Value = oFS.GetFile(strFilename).Datelastmodified 
    Set oFS = Nothing
End Sub
4

2 に答える 2

0

ファイルの名前が別のシートにある場合は、その範囲のセルを反復処理する別の関数を作成する必要があります。

その関数を配置したら、次の関数を呼び出します。

Sub Timecheck(byval aCell as object,byval X as integer,Y as integer) 
    Dim oFS As Object 
    Dim strFilename As String 
    strFilename = aCell.Text 
    Set oFS = CreateObject("Scripting.FileSystemObject") 
    Sheets("tab").Activate
    ActiveSheet.Cells(X,Y).Value = oFS.GetFile(strFilename).Datelastmodified 
    Set oFS = Nothing
End Sub

ここで、XとYは、データを配置するセルの座標です。他のシートから取得した範囲のセルを渡すことによって、データを呼び出します。

または、範囲を移動する必要がない場合は、各ファイル名を新しいシートの1つのセルに入れ、名前に表示されない文字で区切ります。次に、それをファイル名に分割します。

幸運を。

編集：

セル内の区切りリスト内のアイテムを反復処理する場合は、オブジェクトにセルテキストを配置したら次のようにします。

http://msdn.microsoft.com/en-us/library/6x627e5f(v=vs.80).aspx

の入力で'filename1.xls^filename2.xls^filename3.xls'

ファイルリストを含むセルオブジェクトができたら呼び出します

DoStuff(cellObejct, "^")

Public Sub DoStuff( byval aCell as object, byval specialChar as string)
    Dim ListOfNames as Variant
    Dim intIndex, xCell, yCell as integer

    ListOfNames = Split(aCell.Text,specialChar)

    xCell = 1
    yCell = 1

    For intIndex = LBound(ListOfNames) To UBound(ListOfNames) 
        TimeCheck(ListOfNames(intIndex),xCell,yCell)
        yCell = yCell + 1            
    Next intIndex
End Sub

    Sub Timecheck(byval fName as string,byval X as integer,Y as integer) 
        Dim oFS As Object 
        Set oFS = CreateObject("Scripting.FileSystemObject") 
        Sheets("tab").Activate
        ActiveSheet.Cells(X,Y).Value = oFS.GetFile(fName).Datelastmodified 
        Set oFS = Nothing
    End Sub
于 2012-11-28T21:28:26.773 に答える
0

フォルダーをループするには:

Sub timecheck()
Dim FSO As Object
Dim FLD As Object
Dim fil As Object
Dim i As Long
Dim strFolder As String
i = 1

strFolder = "C:\Your Folder Name"

'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
Set FLD = FSO.GetFolder(strFolder)

'loop through the folder and get the file names
For Each fil In FLD.Files
    Sheets("Sheet1").Cells(i, 1) = fil.Name ' Filename in column A
    Sheets("Sheet1").Cells(i, 2) = fil.datelastmodified ' Date in column B
    i = i + 1
Next
End Sub
于 2012-11-28T21:27:32.293 に答える