VBA, MS Access MS Access в примерах

Копирование, удаление, переименование, перемещение, создание папок и файлов

Удаление файла


    Kill "C:\Temp\TestFile.txt"

Копирование файла


    FileCopy "Исходный Путь", "Путь Назначения"


Dim FSO As Object  'Обьект FSO (File System Object)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CopyFile "c:\mydocuments\letters\*.doc", "c:\tempfolder\"


Перемещение файла

    
Dim FSO As Object  'Обьект FSO (File System Object)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.MoveFile "c:\mydocuments\letters\*.doc", "c:\tempfolder\"


Изменение имени файла или папки (перемещение)


    Name "Исходный Путь" As "Новый Путь"

Создание папки (только по одной папке за раз)


    MkDir "C:\Новая папка"

Удаление паки (только без файлов)


    RmDir "C:\Новая папка"

Перемещение файлов из одной папки в другую по маске

Public Sub esFilesMove(sSrsDir As String, sDstDir As String, Optional sMask As String = "*.*")
'es - 25.04.2013
'Перемещение файлов из одной папки в другую по маске (названию)
'Аргументы:
'   sSrsDir = Исходная папка
'   sDstDir = Папка назначения
'   sMask   = маска файлов (или просто имя)
'--------------------------------------------------------------------
Dim s As String
On Error GoTo esFilesMove_Err
 
'проверка слешей
    If Right(sSrsDir, 1) <> "\" Then sSrsDir = sSrsDir & "\"
    If Right(sDstDir, 1) <> "\" Then sDstDir = sDstDir & "\"
    
'Проверка и создание папки назначения (если надо)
    If Dir(sDstDir, vbDirectory) = "" Then MkDir (sDstDir)
'Если файлы в папке назначения уже существуют (ВНИМАНИЕ! - Удаление по МАСКЕ!)
    If Dir(sDstDir & sMask) <> "" Then Kill sDstDir & sMask

'Пое-е-е-е-е-хали!
    s = Dir(sSrsDir & sMask)
    While s <> ""
        Name sSrsDir & s As sDstDir & s 'Перемещение
        s = Dir 'след. файл
    Wend

esFilesMove_Bye:
    Exit Sub

esFilesMove_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure esFilesMove", vbCritical, "Error!"
    Resume esFilesMove_Bye
End Sub

Achtung!
Для FileSystemObject - требуется установить ссылку на Microsoft Scripting RunTime (C:\Windows\System32\scrrun.dll)

Назад ToTop
L.E. 28.05.2020
Рейтинг@Mail.ru