Форум программистов, компьютерный форум, киберфорум
Наши страницы

VBA

Войти
Регистрация
Восстановить пароль
 
Drump6r
0 / 0 / 0
Регистрация: 17.03.2015
Сообщений: 1
#1

Microsoft Access. Перенос файлов - VBA

21.07.2015, 09:29. Просмотров 335. Ответов 0
Метки нет (Все метки)

Всем доброго времени суток. Имеется такая нужда и проблема.
Есть огромный список файлов. Получаю список файлов с полным путём и собираю их в таблицу.
Затем в excel напротив ячейки с файлом - пишу новый путь для данного файла.
После этого загоняю таблицу в access (Там привычнее формы использовать для таких дел).

При использовании следующего макроса файлы благополучно переносятся из папок, обозначенных в столбце otkuda в папки, обозначенные в столбце kuda1 (не спрашивайте "почему именно 1", Делалось на скорую руку). Использовался модуль FSO (FileSystemObject) (Автор: Дмитрий Сонных (aka Joss))

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Option Compare Database
Function PeremeseniyeFilov(otkuda1 As String, kuda1 As String)
    On Error GoTo vihod
    Dim fso As FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.MoveFile otkuda, kuda, True
    Exit Function
vihod:
    'MsgBox "Ошибка № " & Err.Number & " " & Err.Description
End Function
Function CopyFile(otkuda As String, kuda As String)
    On Error GoTo vihod
    Dim fso As FileSystemObject
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Dir(kuda, vbDirectory) = "" Then
    MkDir kuda
    fso.CopyFile otkuda, kuda, True
    Else
     fso.CopyFile otkuda, kuda, True
    End If
    Exit Function
vihod:
    'MsgBox "Ошибка № " & Err.Number & " " & Err.Description
End Function
 
Private Sub copy_Click()
    On Error GoTo vihod
    Dim db As Database
    Dim rs As Recordset
    Dim str As String
    Dim lngRecordCount As Long
        Set db = CurrentDb
        Set rs = db.OpenRecordset("files", dbOpenDynaset)
            If rs.RecordCount <> 0 Then
                rs.MoveLast
            lngRecordCount = rs.RecordCount
                rs.MoveFirst
        str = "Количество записей в таблице ""files"": " & lngRecordCount & vbCrLf
Do Until rs.EOF
 
Call CopyFile(Me.otkuda, Me.kuda)
    DoCmd.GoToRecord , , acNext
    rs.MoveNext
    Loop
Else
    str = "Таблица ""files"" не содержит записей."
End If
 
Debug.Print str
    rs.Close
    db.Close
vihod: 'MsgBox "Ошибка № " & Err.Number & " " & Err.Description
 
End Sub
 
Private Sub Ex_Click()
    DoCmd.Close
End Sub
 
Private Sub move_Click()
    On Error GoTo vihod
    Dim db As Database
    Dim rs As Recordset
    Dim str As String
    Dim lngRecordCount As Long
        Set db = CurrentDb
        Set rs = db.OpenRecordset("files", dbOpenDynaset)
            If rs.RecordCount <> 0 Then
                rs.MoveLast
            lngRecordCount = rs.RecordCount
                rs.MoveFirst
        str = "Количество записей в таблице ""files"": " & lngRecordCount & vbCrLf
Do Until rs.EOF
 
Call PeremeseniyeFilov(Me.otkuda, Me.kuda)
DoCmd.GoToRecord , , acNext
rs.MoveNext
Loop
Else
str = "Таблица ""files"" не содержит записей."
End If
Debug.Print str
rs.Close
db.Close
vihod: 'MsgBox "Ошибка № " & Err.Number & " " & Err.Description
 
End Sub




В данном случае с помощью этого кода можно перенести/копировать файлы только в те папки, которые уже 100% существуют.
Требуется модернизировать его так, чтобы он так же составлял самостоятельно дерево каталогов(все необходимые папки и подпапки* из списка kuda1), если таких не существует. С этим то и возникла проблема. Решения пока не нашел.
Быть может Вы сможете помочь.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.07.2015, 09:29
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Microsoft Access. Перенос файлов (VBA):

Перенос таблицы из access - VBA
Добрый день! Помогите пожалуйста. Нужно перенести данные из access в excel. Заголовками столбцов должны быть описания полей из access....

Перенос данных из Excel в Access - VBA
День Добрый!Есть таблица Excel и база данных Access.Нужно написать код на кнопку,который бы переносил данные из Excel в Access....

Перенос данных из Access в Excel - VBA
Добрый вечер. столкнулся с проблемой, нужно перенести данные из accsse в excel. Option Compare Database Sub Test() Dim...

Перенос информации из Access в Excel - VBA
Здравствуйте! Перенос информации из Access в Excel происходит по этому коду, но у меня появилась одна проблема, нужно сделать так что бы в...

Перенос данных из Excel в Access - VBA
Здравствуйте ! Очень прошу спуститься до нулевого уровня VBA и подсказать, как нажав на кнопку в 1.xlsm перенести данные из ячеек,...

Checkbox и Access. Перенос значений - VBA
Имеется форма (рис.1) на которой расположены 6 Сheckbox'ов, 1 TextBox и 1 кнопка. Можно ли программно отследить результат в каждом из...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.07.2015, 09:29
Привет! Вот еще темы с ответами:

Перенос данных из Экселя в Access - VBA
Уж прошу меня простить, но как то ленился всегда занятся изучением совместной работы приложений. А сейчас срочно понадобилось. Поэтому,...

Перенос информации из Access в Excel - VBA
Здравствуйте. Данную тему уже поднимал. У меня перенос информации из Access в шаблон Excel происходит по этому коду, но нужно сделать...

Перенос даты из Access в Excel - VBA
Здравствуйте. Возникла задача выгрузить в Excel содержимое табличной формы из бд на Аксесс. Делаю я это так: Dim PrintRep As Object Dim...

Перенос данных из excel в access - VBA
Всем добрый день! У меня простой код Sub Inter() DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel10, &quot;Òàáëèöà1&quot;,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru