'---------------------------------------------------------------------------------------
' Module    : mSaveAsMass
' DateTime  : 25.02.2014 18:02
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             http://www.excel-vba.ru
' Purpose   :
'---------------------------------------------------------------------------------------
Option Explicit

Sub SaveAs_Mass()
    Dim sFolder As String, sFiles As String, sNonEx As String
    Dim lPos As Long
    sFolder = ThisWorkbook.Path
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    sFiles = Dir(sFolder & "*.xls")
    Do While sFiles <> ""
        If sFiles <> ThisWorkbook.Name Then
            lPos = InStrRev(sFiles, ".")
            sNonEx = Mid(sFiles, 1, lPos)
            Workbooks.Open sFolder & sFiles, False
            ActiveWorkbook.SaveAs sFolder & sNonEx & "xlsb", 50
            ActiveWorkbook.Close 0
        End If
        sFiles = Dir
    Loop
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = 1
End Sub

Sub Скорректировать_время_изменения_файлов()
    Dim objShell As Object, objFolder As Object, objItem As Object
    Dim DateTimeTemp As Date, S As String
    Dim Coll As New Collection, FSO As Object, iEXT As String, sFileNameWOExt As String, sFolder As String
    
    sFolder = ThisWorkbook.Path
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(CStr(sFolder))
    
    For Each objItem In objFolder.Items
        If objItem <> ThisWorkbook.Name Then
            iEXT = FSO.GetExtensionName(objItem.Name)
            If LCase(iEXT) = "xls" Then
                sFileNameWOExt = Left(objItem, InStrRev(objItem, ".") - 1)
                DateTimeTemp = CDate(objItem.ModifyDate)
                Coll.Add DateTimeTemp, sFileNameWOExt
            End If
        End If
    Next
        
    For Each objItem In objFolder.Items
        If objItem <> ThisWorkbook.Name Then
            iEXT = FSO.GetExtensionName(objItem.Name)
            If LCase(iEXT) = "xlsb" Then
                sFileNameWOExt = Left(objItem, InStrRev(objItem, ".") - 1)
                S = Coll.Item(sFileNameWOExt)
                'S = Format$(S, "dd.mm.yyyy hh:mm:ss")
                objItem.ModifyDate = S
                S = Empty
            End If
        End If
    Next
    
    Set FSO = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
    MsgBox "Данные времени изменены!", vbInformation, "Конец"
End Sub