Макрос 2003 в 2007 как откорректировать
Добавлено: 20 май 2009, 07:27
И был у меня вот такой вот замечательный макрос.
И перешла контора на офис 2007 покупной.
И перестал работать мой замечательный макрос.....
Помогите пожалуйста исправить.
===================================
' Макрос собирает на лист "Сборник" со всех листов "Готовый лист" всех файлов, которые находятся в текущей диретории
Sub sborka()
Dim iFileName$, iPath$
Dim TxtFile As Workbook
Dim OrigWB As Workbook
Set OrigWB = ActiveWorkbook ' Книга в которую будем все собирать
iPath = ThisWorkbook.Path & "\"
iFileName = Dir(iPath & "*.xls")
Set fs = Application.FileSearch
With fs
.LookIn = iPath
.Filename = "*.xls*"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> iPath & iFileName Then
Workbooks.Open Filename:=.FoundFiles(i)
Set TxtFile = ActiveWorkbook
lastrow = OrigWB.Worksheets("Сборник").Cells.SpecialCells(xlLastCell).Row
' Сборник - это лист того файла куда собираем все
TxtFile.Worksheets("Готовый лист").Range("A1:AK3000").Copy Destination:=OrigWB.Sheets("Сборник").Cells(lastrow + 1, 1)
' "Готовый лист" - одинаковое название листа во всех файлах "A1:C5" - область которую копируем
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
=================================================
Ругается как минимум на Set fs = Application.FileSearch
Что еще не понравится я не знаю...
И перешла контора на офис 2007 покупной.
И перестал работать мой замечательный макрос.....
Помогите пожалуйста исправить.
===================================
' Макрос собирает на лист "Сборник" со всех листов "Готовый лист" всех файлов, которые находятся в текущей диретории
Sub sborka()
Dim iFileName$, iPath$
Dim TxtFile As Workbook
Dim OrigWB As Workbook
Set OrigWB = ActiveWorkbook ' Книга в которую будем все собирать
iPath = ThisWorkbook.Path & "\"
iFileName = Dir(iPath & "*.xls")
Set fs = Application.FileSearch
With fs
.LookIn = iPath
.Filename = "*.xls*"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> iPath & iFileName Then
Workbooks.Open Filename:=.FoundFiles(i)
Set TxtFile = ActiveWorkbook
lastrow = OrigWB.Worksheets("Сборник").Cells.SpecialCells(xlLastCell).Row
' Сборник - это лист того файла куда собираем все
TxtFile.Worksheets("Готовый лист").Range("A1:AK3000").Copy Destination:=OrigWB.Sheets("Сборник").Cells(lastrow + 1, 1)
' "Готовый лист" - одинаковое название листа во всех файлах "A1:C5" - область которую копируем
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
=================================================
Ругается как минимум на Set fs = Application.FileSearch
Что еще не понравится я не знаю...