Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 173075
08.10.2009, 22:40
25.00 руб.
0 5 2
Компьютеры Программирование
Добрый вечер уважаемые эксперты.

VBA EXCEL

Общая задача:
в одной папке находится анкеты установленного образца и БД.xls. По задумке определённая информация из анкет(тоже xls) должна попасть в БД.

Общий вопрос такой.
Каким образом, по нажатию кнопки в файле БД, можно в цикле перенести определённую информацию из анкет в БД? То есть получить список имен в папке, поместить в массив и поочерёдно открывать анкеты, копировать инфо и закрывать?

Обсуждение

давно
Megaloman
Модератор
137394
1850
09.10.2009, 09:36
общий
Соколов В.В.:
При такой неопределённой постановке что-то вразумительно ответить трудно. Нет проблем написать макрос, который будет поочерёдно открывать экселевские таблицы и что-то куда-то переносить, затем их закрывать. Сомневаюсь, что кто-то даст более конкретный ответ. И сомневаюсь, что это Вас устроит. Попробуйте максимально конкретизировать вопрос вплоть до предоставления образцов таблиц и базы. Чем конкретнее сформулируете проблему, тем скорее получите более эффективное решение. Разместить Ваши образцы файлов можно на rfpro.ru (на главной странице слева кнопка Мои файлы)
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
09.10.2009, 10:13
общий
Megaloman:
Извините, постараюсь конкретизировать.
Мне нужен сам принцип, алгоритм:

Пример достаточно показать в перенесение одной ячейки каждой анкеты в БД. Перенесенные данные достаточно разместить последовательно в любом направление.

Имея такой макрос, я смогу по аналогу дополнить его сам.

Проблема в принципе для меня заключается именно в том, как открыть поочередно файлы в одной папке и перенести данные в БД(это тоже просто excel таблица), а потом закрыть. То есть пенести данные и закрыть файл я могу, а вот с открытием у меня проблема
Неизвестный
09.10.2009, 10:16
общий
это ответ
Здравствуйте, Соколов В.В..
Sub Макрос1()
'
' Макрос1 Макрос
'

'
Dim a(50) As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
If .Show = -1 Then
n = 1
For Each vrtSelectedItem In .SelectedItems
a(n) = vrtSelectedItem
n = n + 1
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
For i = 1 To n - 1
lcFile = a(i)
Workbooks.Open lcFile
' перенос данных
' закрытие файла lcFile


Next i


End Sub
4
Ответ на вопрос был получен, но не точно. Можно использовать, но не то что требовалось.
Неизвестный
09.10.2009, 10:39
общий
Архипов Александр Леонидович:
Один вопрос, как это сделать без диалогового окна? Как получить список файлов в папке(это в принципе не сложно же), и открыть последовательно каждый их этих файлов, перенести информацию и закрыть.
давно
Megaloman
Модератор
137394
1850
09.10.2009, 16:36
общий
это ответ
Здравствуйте, Соколов В.В.. Вот макрос, который последовательно открывает эксел-файлы по маске в указанной папке, забирает в массив значение указанных клеток, заносит их в сводную таблицу (базу), закрывает открытый макросом файл
Код:
Sub Svod()
' Исходные данные
    RabDir = "H:\Delete\Откуда грузим"      ' Где данные для загрузки
    Maska = "*.xls"                         ' Маска имени загружаемых файлов
    
    SvodFileName = "Загрузка файлов.xls"    ' Наименование файла с базой
    ListSvod = "База"                       ' Имя листа со сводом
    
    ChDir RabDir
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Tdir = FSO.GetFolder(RabDir)
    Set AllFiles = Tdir.Files
    
    Dim Mass(2) As Variant
        
    Sheets(ListSvod).Select
    Columns("A:Q").ClearContents             ' Очищаю лист куда буду грузить
    Range("A1").Select
    
    i = 0
    For Each iFile In AllFiles
        jName = iFile.Name
        
        If jName Like Maska Then
            Range("A1").Offset(i, 0) = jName            ' Отладочная печать имён файлов в директории
            On Error Resume Next
                Workbooks.Open Filename:=RabDir + "" + jName    ' Открываем Exel файл
        
                If Err.Number = 0 Then
                    On Error GoTo 0
                    
                    For j = 0 To 2                              ' Забираем данные в массив
                        Mass(j) = Range("A1").Offset(j, 0)
                    Next
                    
                    Windows(SvodFileName).Activate
                    For j = 0 To 2                              ' Забираем данные из массива
                        Range("B1").Offset(i, j) = Mass(j)
                    Next
                    
                    Workbooks(jName).Close SaveChanges:=False   ' Закрываем книгу из которой брали данные
                End If
    

            i = i + 1
        End If
    Next

End Sub


К ответу прикрепил пример, который можете загрузить. В макросе настройте свои пути
Прикрепленные файлы:
5
Спасибо большое, именно то что требовалось, не больше не меньше! Вся понятно, комментарии избыточны.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Форма ответа