Цикл по папкам через VBA

@businka_5d · Регистрация: 29.07.2015

Студворк — интернет-сервис помощи студентам

Добрый день!

Помогите придумать решение:
Необходимо сделать сравнение файлов в 2х папках по именам (они с одинаковыми названием, но разным расширением.Пока прописан jpg). Само сравнение пока не прописано, так как у меня не получается реализовать цикл по 2-м папкам: повторной вызов DIR приводит к ошибке 05 из-за того,
что он продолжает проход по файлам 1ой папки (из кода видно,где это происходит). Вот как этот с помощью dir-а найти следующий файл в каждой из папок, чтобы последовательно сравнить каждый файл с каждым?

Подскажите, как разрешить данную проблему?

Заранее огромное всем спасибо!!!

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
Sub Files()
    Dim sFolder As String, sFiles As String
    Dim sFolder1 As String, sFiles1 As String
    
    MsgBox ("файлы 1 типа")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    
    MsgBox ("файлы 2 типа")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder1 = .SelectedItems(1)
    End With
    
    sFiles = Dir(sFolder & Application.PathSeparator & "*.jpg")
    sFiles1 = Dir(sFolder1 & Application.PathSeparator & "*.jpg")
    Do While sFiles <> ""                   
                Do While sFiles1 <> ""
                        'здесь будет сравнение и копирование
                        sFiles1 = Dir 
                Loop
                sFiles = Dir ' Вот тут и начинается проблема....так как dir идет по предыдущему
                                  'каталогу,  а так как цикл окончен,его значение ""
    Loop
    
End Sub

@Апострофф · 09.12.2015, 11:23

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
Option Explicit
 
Sub Files()
    Dim sFolder As String, sFiles As String, a() As String, u As Long
    Dim sFolder1 As String, sFiles1 As String, a1() As String, u1 As Long
    
    MsgBox ("файлы 1 типа")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    
    MsgBox ("файлы 2 типа")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder1 = .SelectedItems(1)
    End With
    
    sFiles = Dir(sFolder & Application.PathSeparator & "*.jpg")
    Do While sFiles <> ""
      ReDim Preserve a(u): a(u) = sFiles: u = u + 1
      sFiles = Dir
    Loop
    
    sFiles1 = Dir(sFolder1 & Application.PathSeparator & "*.jpg")
    Do While sFiles1 <> ""
      ReDim Preserve a1(u1): a1(u1) = sFiles1: u1 = u1 + 1
      sFiles1 = Dir
    Loop
    
    'теперь циклами сравниваете два массива
 
End Sub

@businka_5d · 22.12.2015, 09:33 **[ТС]**

Апострофф, спасибо!
Сделала с помощью одного массива. Не хотела с ними сначала связываться, но так гораздо удобнее)
Получилось вот так:

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
Sub Files()
    Dim sFolder As String, sFiles As String, a() As String, u As Long
    Dim sFolder1 As String, sFiles1 As String, a1() As String, u1 As Long
    
    MsgBox ("Выберите каталог с  JPEG")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    
    MsgBox ("Выберите каталог с  DOCX")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder1 = .SelectedItems(1)
    End With
    
    MkDir (sFolder & "" & "DOC_copy")
        
    sFiles = Dir(sFolder & Application.PathSeparator & "*.jpg")
    Do While sFiles <> ""
        'ReDim Preserve a(u): a(u) = sFiles: u = u + 1
        ReDim Preserve a(u): a(u) = Mid(sFiles, InStrRev(sFiles, "") + 1, InStrRev(sFiles, ".") - InStrRev(sFiles, "") - 1): u = u + 1
      sFiles = Dir
    Loop
    sFiles1 = Dir(sFolder1 & Application.PathSeparator & "*.docx")
 
                Do While sFiles1 <> ""
                    For i = 0 To UBound(a) - LBound(a)
                        If (Mid(sFiles1, InStrRev(sFiles1, "") + 1, InStrRev(sFiles1, ".") - InStrRev(sFiles1, "") - 1)) = a(i) Then
                            FileCopy sFolder1 + "" + sFiles1, sFolder + "\DOC_copy" + sFiles1
                        End If
                        Next i
                        sFiles1 = Dir
                    Loop
        MsgBox ("Копирование завершено")
 
    
End Sub

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .