Sub dt()
Dim fl
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each fl in FSO.GetFolder("C:\temp\svod\").Files
'Открытие файла и проставление даты. Тут либо циклом по листам, либо только первый?
Next
End Sub

Sub InsertDate()
      Dim wb As Workbook
      Dim x As String
      Dim pthname As String
      Dim ch_dir As String
      Dim cl As String
            
      ch_dir = "D:\$\" 'подставьте свой путь
      x = "*.xls?"     'и свою маску
      cl = "C3"        'и ячейку, в которую занести дату
      Application.ScreenUpdating = False
      pthname = ch_dir & x
      nf = nmfile
      nmfile = Dir(ch_dir & x)
      Do While nmfile <> ""
          If ch_dir + nmfile = ThisWorkbook.FullName Then
              Range(cl).Value = CDate("16.11.2013")
          Else
              Set wb = Workbooks.Open(ch_dir + nmfile)
              Range(cl).Value = CDate("16.11.2013")
              wb.Close 0
          End If
          nmfile = Dir()
      Loop
      Application.ScreenUpdating = True
End Sub

Sub dt()
Application.DisplayAlerts = False
Dim fl
Dim directory$: directory = "C:\"
Dim dt As Date: dt = "01.09.2013"
Set FSO = CreateObject("Scripting.FileSystemObject")
     For Each fl In FSO.GetFolder(directory).Files
         If fl.Name Like "*.xls*" Then
             Set wb = Workbooks.Open(fl)
             wb.Sheets(1).[k5].Value = dt
             wb.Close True
         dt = dt + 1
         End If
     Next
Application.DisplayAlerts = True
End Sub

If fl.Name Like "*.xls*"  and thisworkbook.name <> fl.name Then

If fl.Name Like "*.xls*" Then

If fl.Name Like "*.xls*" and thisworkbook.name <> fl.name Then