Прошу помощи в соединении макросов Excel

[Alexsandrr]

Вот макрос указанный на обсуждаемой ранее теме по открытию нескольких книг в одной папке.

Sub Макрос1() ' скачан на "http://excelvba.ru/code/CombineFiles"
On Error Resume Next: Err.Clear
' запрашиваем пути к папкам с файлами
InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами заявок (из Outlook)")
If InvoiceFolder$ = "" Then MsgBox "Не задана папка с заявками", vbCritical, "Обработка заявок невозможна": Exit Sub

ArchieveFolder$ = GetFolder(2, , "Выберите папку, куда будут помещаться обработанные файлы заявок")
If ArchieveFolder$ = "" Then MsgBox "Не задана папка для архива заявок", vbCritical, "Обработка заявок невозможна": Exit Sub

Dim coll As Collection
' загружаем список файлов по маске имени файла
Set coll = FilenamesCollection(InvoiceFolder$, "Заявка №*от*.xls*", 1)

If coll.Count = 0 Then
MsgBox "Не найдено ни одной заявки для обработки в папке" & vbNewLine & InvoiceFolder$, _
vbExclamation, "Нет необработанных заявок"
Exit Sub
End If

Dim pi As New ProgressIndicator: pi.Show "Обработка заявок", , 2
pi.StartNewAction , , , , , coll.Count ' отображаем прогресс-бар

Dim WB As Workbook, sh As Worksheet, ra As Range
Application.ScreenUpdating = False ' отключаем обновление экрана (чтобы процесс открытия файлов не был виден)

' перебираем все найденные в папке файлы
For Each Filename In coll

' обновляем информацию на прогресс-баре
pi.SubAction "Обрабатывается заявка $index из $count", "Файл заявки: " & Dir(Filename), "$time"
pi.Log "Файл: " & Dir(Filename)

' открываем очередной файл в режиме «только чтение»
Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)

If WB Is Nothing Then ' не удалось открыть файл
pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."

Else ' файл успешно открыт
Set sh = WB.Worksheets(1) ' будем работать с первым листом
' удаляем первые 2 столбца
sh.range("a:b").entirecolumn.delete

WB.Close TRUE: DoEvents ' закрываем обработанный файл с сохранением изменений
pi.Log vbTab & "Файл успешно обработан."

End If
Next

' закрываем прогресс-бар, включаем обновление экрана
pi.Hide: DoEvents: Application.ScreenUpdating = True
MsgBox "Обработка заявок завершена", vbInformation
End Sub

[Alexsandrr]

У меня в папке "V:\Отдел планирования закупок\2013\ЗАПАСЫ\Форум\Заявочная " находятся книги (7_10_Заявка ФПК_КРАС_01кв, 22_5_Заявка ФПК_ПРИВ_03кв, ....,....). Данных книг порядка 60 шт, которые обрабатываются вот этим макросом2 (прикреплен в папке)


Мне нужно Макрос2 соединить с Макрос1, чтобы Макрос1 обеспечил открытие каждой книги по очереди, а Макрос2 каждую открытую книгу обработал.

[maksim_serg]

вот это:

Set sh = WB.Worksheets(1) ' будем работать с первым листом
' удаляем первые 2 столбца
sh.range("a:b").entirecolumn.delete

WB.Close TRUE: DoEvents ' закрываем обработанный файл с сохранением изменений
pi.Log vbTab & "Файл успешно обработан."

End If

заменить на это:

call Макрос2(WB,1)

WB.Close TRUE: DoEvents ' закрываем обработанный файл с сохранением изменений
pi.Log vbTab & "Файл успешно обработан."

End If

вот это:

Sub Макрос2()
    ' снять объединение ячеек и перенос слов
    Columns("A:AA").Select

заменить на это:

Sub Макрос2(ByVal tBook As Workbook, ByVal SheetIndex As Integer)
    ' снять объединение ячеек и перенос слов
    With tBook.Sheets(sheetsindex)
    .Columns("A:AA").Select' и вот эту вот точку надо будет поставить перед ссылкой на ячейку, строку, столбец
...
End With
End sub

[Alexsandrr]

В объединении макросов, в строке "InvoiceFolder$ = GetFolder(1, , "Выберите папку с файлами заявок (из Outlook)")" выдает ошибку "Sub or Function not defined-Подпрограмма или функция не определена" и выделяет данное слово "GetFolder":


Не могли бы посмотреть сам макрос?

[Alexsandrr]

вот файл, забыл вставить

[Alexsandrr]

Может быть данные Функции VBA для получения списка файлов из папки,
с учётом выбранной глубины поиска в подпапках нужны, чтобы макрос работал?
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
Optional ByVal SearchDeep As Long = 999) As Collection
' Получает в качестве параметра путь к папке FolderPath,
' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
' Возвращает коллекцию, содержащую полные пути найденных файлов
' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

Set FilenamesCollection = New Collection ' создаём пустую коллекцию
Set FSO = CreateObject("Scripting.FileSystemO bject") ' создаём экземпляр FileSystemObject
GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
Set FSO = Nothing: Application.StatusBar = False ' очистка строки состояния Excel
End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
' перебор папок осуществляется в том случае, если SearchDeep > 1
' добавляет пути найденных файлов в коллекцию FileNamesColl
On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
If Not curfold Is Nothing Then ' если удалось получить доступ к папке

' раскомментируйте эту строку для вывода пути к просматриваемой
' в текущий момент папке в строку состояния Excel
' Application.StatusBar = "Поиск в папке: " & FolderPath

For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath
If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
Next
SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках
If SearchDeep Then ' если надо искать глубже
For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath
GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
Next
End If
Set fil = Nothing: Set curfold = Nothing ' очищаем переменные
End If
End Function

[Alexsandrr]

Никто не подскажет?

[maksim_serg]

Поверьте, это не единственная ошибка, которую выдаст. там их будет куча

[maksim_serg]

как то так

[Alexsandrr]

Вот спасибо!!!!!!!!
Только можно еще вопрос? Путь я поправил к папке, только не видит мои файла Excel. Я понимаю в этой строке проблема:

Dim coll As Collection
' загружаем список файлов по маске имени файла
Set coll = FilenamesCollection(InvoiceFolder$, "Заявка №*от*.xls*")

Файлы у меня называются к примеру "7_10_Заявка ФПК_КРАС_01кв", "1_08_Заявка ФПК_ПРИВ_04кв". Неизменные части :"Заявки", "ФПК", "кв".
Или вообще просто сделать чтобы видел все книги Excel, а я мог выбрать любые.

Большое спасибо за оказанное содействие!