| |
サブフォルダ内も対象というところを読み飛ばしてました。
その参照ページは参考になりませんね、失礼しました。
というよりも、あなた自身が最近同じ質問をされていたようですね。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=74572;id=excel
データを取ってくるんじゃなくて、
特定シートの特定セルを書き換えて保存する点が違うだけのようですから、
ご自分でも対応出来そうに思います。
上記のものとは少しちがって、時間は少しかかるかもしれませんが、
以下のような書き方もあると思います。
フォルダの中のファイルを処理して、
次に、そのサブフォルダを対象に同じ処理を実行させます。
こういうのを再帰処理といいます。
なお、Excelファイルに対する処理は、
taskプロシージャとして外に出していますから、
その部分だけ変更すれば良いはずです。
（対象となるフォルダ名は変更してください。）
----------------
'' 「Microsoft Scripting Runtime」の参照設定が必要
Dim fso As FileSystemObject
Sub test()
Dim myFolderName As String
Application.ScreenUpdating = False
'対象となるフォルダ
myFolderName = "D:\test" '' ここは修正
Set fso = New FileSystemObject
Call walk_folder(fso.GetFolder(myFolderName))
Set fso = Nothing
Application.ScreenUpdating = True
MsgBox "処理終了"
End Sub
Function walk_folder(ByVal objPATH As Folder)
Dim myPath2 As Folder
Dim myFile As File
For Each myFile In objPATH.Files
If fso.GetExtensionName(myFile.Name) = "xls" Then
Call task(myFile.Path)
End If
Next
For Each myPath2 In objPATH.SubFolders
Call walk_folder(myPath2)
Next
Set objPATH = Nothing
End Function
Function task(fname As String)
Dim wb As Workbook
Set wb = Workbooks.Open(fname)
wb.Sheets(1).Range("A1").Value = 1
wb.Save
wb.Close False
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
