LEADERSOFT.ru Разработка на заказ программ и сайтов
ЕСЛИ БАЗА ВАМ НУЖНА В ЛИДЕРСОФТ ЗАЙДИ СПЕРВА!
Все примеры Microsoft Access - VBA


















































если Вам необходимо из 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