Sub ZmieńRozszerzenia()
    On Error GoTo ZmieńRozszerzenia_Error

    Dim objFSO As Object 'Scripting.FileSystemObject
    Dim objFolder As Object 'Scripting.Folder
    Dim objFile As Object 'Scripting.File
    Dim xlApp As Excel.Application
    Dim wkb As Excel.Workbook
    Dim strXLSName As String

    Const strFolderName As String = "C:\Documents and Settings\steo\Pulpit\pliki"


    Set xlApp = New Excel.Application
    With xlApp
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderName)

    For Each objFile In objFolder.Files
        With objFile
            If .Name Like "*.xlsm" Then
                strXLSName = Left(.Name, Len(.Name) - 1)
                Set wkb = xlApp.Workbooks.Open(.Path)
                With wkb
                    .SaveAs Filename:=strFolderName & "\" & strXLSName, _
                            FileFormat:=xlExcel8
                    .Close SaveChanges:=False
                End With
                Set wkb = Nothing
                VBA.Kill .Path
            End If
        End With
    Next

    MsgBox "steo mowi, ze dziala", vbInformation

ZmieńRozszerzenia_Exit:
    On Error Resume Next
    If Not wkb Is Nothing Then
        wkb.Close SaveChanges:=False
        Set wkb = Nothing
    End If
    If Not xlApp Is Nothing Then
        xlApp.Quit
        Set xlApp = Nothing
    End If
    Set objFolder = Nothing
    Set objFSO = Nothing
Exit Sub

ZmieńRozszerzenia_Error:
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _
            Err.Description, vbExclamation, "VBAProject - ZmiRoz"
    Resume ZmieńRozszerzenia_Exit
End Sub