Программирование на Visual Basic | Microsoft Access. Управление папками

В этом разделе сайта находятся примеры из сборника программ "Архив файлов на Microsoft Access". В нем рассказывается о программировании форм, отчетов, таблиц и других объектов. Используйте этот архив для изучения работы с приложением Microsoft Office Access и программированием на Visual Basic for Application. Тем кто уже знаком с VBA, используйте поиск для нахождения кодов. Наберите, например, DAO, ADO, Recordset и найдете нужную ссылку для решения проблемы с программированием

Microsoft Access. Управление папками

если Вам необходимо из Microsoft Access управлять файлами, то этот набор функций раскажет как это сделать. Вы сможете удалять, создавать и копировать папки.

' Создание пустой папки
'   fs.CreateFolder "c:\a"
'
Private Sub butCreateFolder_Click()
On Error GoTo 999
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
    'Создаем папку
    fs.CreateFolder Me.myFolder
    Set fs = Nothing
    MsgBox "Папка: "  Me.myFolder  " создана!", vbInformation, "Создание папки"
    Exit Sub 'Выходим из программы
999:
    MsgBox Err.Description
    Err.Clear 'Очищаем поток от ошибок
End Sub

' Копирование папки c ее содержимым
'   fs.CopyFolder "c:\a", "c:\a1"
'
Private Sub butCopyFolder_Click()
On Error GoTo 999
    Dim fs, strNewFolder As String, flagExecute As Long
    Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
    
    strNewFolder = Me.myFolder  "1" ' Новое имя
    flagExecute = MsgBox("Копировать папку: "  vbNewLine  _
        Me.myFolder  vbNewLine  "в:"  _
        strNewFolder, vbExclamation + vbOKCancel, "Копирование папки")
        
    If flagExecute = vbOK Then _
        fs.CopyFolder Me.myFolder, strNewFolder ' Копирование папки
    
    Set fs = Nothing
    Exit Sub 'Выходим из программы
999:
    MsgBox Err.Description
    Err.Clear 'Очищаем поток от ошибок
End Sub

' Удаление папки c содержимым
'   fs.DeleteFolder "c:\a"
'
Private Sub butDeleteFolder_Click()
On Error GoTo 999
    If MsgBox("Удалить папку: "  Me.myFolder, vbExclamation + vbOKCancel, "Удаление папки") = vbOK Then
        Dim fs
        Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
        'Удаляем папку
        fs.DeleteFolder Me.myFolder
        Set fs = Nothing
    End If
    Exit Sub 'Выходим из программы
999:
    MsgBox Err.Description
    Err.Clear 'Очищаем поток от ошибок
End Sub

' Перемещение папки c содержимым
'   fs.MoveFolder "c:\a", "c:\a1"
'
Private Sub butMoveFolder_Click()
On Error GoTo 999
    Dim fs, strNewFolder As String, flagExecute As Long
    Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
    
    strNewFolder = Me.myFolder  "1" ' Новое имя
    flagExecute = MsgBox("Переместить папку: "  vbNewLine  _
        Me.myFolder  vbNewLine  "в:"  _
        strNewFolder, vbExclamation + vbOKCancel, "Перемещение папки")
        
    If flagExecute = vbOK Then _
        fs.MoveFolder Me.myFolder, strNewFolder ' Перемещение папки
    
    Set fs = Nothing
    Exit Sub 'Выходим из программы
999:
    MsgBox Err.Description
    Err.Clear 'Очищаем поток от ошибок
End Sub

Добавить комментарий

Loading