Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.01.2018, 00:21   #1
Sanalos
Новичок
Джуниор
 
Регистрация: 15.01.2018
Сообщений: 1
По умолчанию Обработка файлов в указанной папке

Добрый день. Просьба помочь с редактированием рабочего макроса.
Данный макрос дает право на ВЫБОР файлов из указанной вами папки (arFiles = .GetOpenFilename("CSV Files (.csv), *.csv", , "Объединить файлы", , True))

Необходимо переделать код так, что б автоматически выбирались ВСЕ файлы csv по заданному пути, например D:\kaluna\dest и обрабатывались как было.
Большое спасибо за помощь!
Код:
Sub Fizik()
 
Const strStartDir = "c:\kaluna\" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\kaluna\" 'папка, в которую будет предложено сохранить результат
Const blInsertNames = True  'вставлять строку заголовка (книга, лист) перед содержимым листа
  
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
    i As Integer, stbar As Boolean, clTarget As Range
  
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application    'меньше писанины
arFiles = .GetOpenFilename("CSV Files (.csv), *.csv", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
 
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
    .ScreenUpdating = False
    stbar = .DisplayStatusBar
    .DisplayStatusBar = True
  
For i = 1 To UBound(arFiles)
    .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
    Set wbSrc = Workbooks.Open(arFiles(i), local:=True)
    For Each shSrc In wbSrc.Worksheets
        If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
            Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)
            If blInsertNames Then
                clTarget = "  "
                Set clTarget = clTarget.Offset(1, 0)
            End If
            shSrc.UsedRange.Copy clTarget
        End If
    Next
    wbSrc.Close False   'закрыть без запроса на сохранение
Next
    .ScreenUpdating = True
    .DisplayStatusBar = stbar
    .StatusBar = False
     
 
On Error Resume Next    'если указанный путь не существует и его не удается создать,
                        'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
'arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
  
'If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
 '   GoTo save_err
'Else
 '   On Error GoTo save_err
  '  wbTarget.SaveAs arFiles
'End If
End
save_err:
    MsgBox "Книга не сохранена!", vbCritical
End With
End Sub
Просьба исправить макрос, а то плохо разбираясь в VBA, заручился( Спасибо
Sanalos вне форума Ответить с цитированием
Старый 15.01.2018, 07:42   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

https://wordmvp.com/FAQs/MacrosVBA/R...sIntoArray.htm
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Интерпретатор команд Linux - вывести в файл структуры каталогов находящихся в папке, указанной пользователем Raemas Linux (Ubuntu, Debian, Red Hat, CentOS, Mint) 1 31.03.2017 20:56
Скрипт, который считает количество файлов в каждой папке, находящихся в данной папке so1idsnake Помощь студентам 20 07.08.2013 22:38
Полные пути до файлов в указанной папке и подпапках. ZARO Общие вопросы Delphi 8 04.08.2010 19:17
Как узнать число файлов и их суммарный размер в указанной папке? 3D Hunter Общие вопросы Delphi 3 11.11.2009 16:26
Отслеживает появление в папке файлов. слежение за определенным файлом в определенной папке. RammFan Win Api 1 09.06.2007 11:09