Перенос файла как опция

[jungo]

Привет Всем!

У меня есть макрос, который копирует файлы из одной директории в другую:

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260


Function BrowseFolder(Optional Caption As String, _
    Optional InitialFolder As String) As String

    Dim SH As Shell32.Shell
    Dim F As Shell32.Folder

    Set SH = New Shell32.Shell
    Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
        InitialFolder)

    If Not F Is Nothing Then
        BrowseFolder = F.Items.Item.Path
    End If

End Function



Sub CopyFilesToFolder()



On Error Resume Next

Dim FName As String
Dim Var(10)

    FName = BrowseFolder("Select A Folder")
    If FName = "" Then
        MsgBox "You didn't select a folder"
    Else
        lr = [a65536].End(xlUp).Row
        For i = 2 To lr
            
            Strt = 1
            Varno = 1

            For Plc = 1 To Len(Cells(i, 1))
                If Mid(Cells(i, 1), Plc, 1) = "\" Then
                    Var(Varno) = (Mid(Cells(i, 1), Strt, Plc - Strt))
                    Varno = Varno + 1
                    Strt = Plc + 1
                ElseIf Plc = Len(Cells(i, 1)) Then
                    Var(Varno) = (Mid(Cells(i, 1), Strt, Plc - Strt + 1))

                End If
            Next Plc
            FileCopy Cells(i, 1), FName & "\" & Var(Varno)
            
        Next i
    End If


End Sub

Можно сделать так, что бы этот макрос не только мог копировать, но и переносить (что бы была опция такая в самом макросе)?
Меня перекрыли фаерволом, поэтому пишите всё тут.

[SAS888]

Мне лень разбирать Ваш код, но почему бы не использовать обычные методы Copy и Move из FileSystemObject? Это же существенно проще.

[jungo]

Если вам лень разбирать мой код, откуда вам знать что проще или лучше?

[SAS888]

Да я не в обиду. Просто копирование (перемещение) файлов из одной директории в другую, делается просто. Вы бы лучше сказали, какие у Вас существуют дополнительные условия (критерии) при выполнении этих операций.

[дмидми]

Здесь и FileSystemObject не нужен: в VBA есть инструкция Name, которая может и переименовывать, и перемещать.

[SAS888]

дмидми

Здесь и FileSystemObject не нужен

Я бы так категорично не заявлял. А если нужно работать с кучей вложенных подпапок, имена которых еще нужно получить?

[дмидми]

А Dir на что?

Я, собственно, хочу всего лишь сказать, что стандартных средств VBA Excel вполне достаточно. Хотя, на мой взгляд, с FileSystemObject действительно удобнее, - но ведь не каждый юзер захочет изучать еще одну надстройку.

[SAS888]

На эту тему можно говорить сколько угодно. Можно и Win-API использовать. Я считаю, что для каждого конкретного случая, чем проще - тем лучше (это касается и наших предыдущих дискуссий).

[jungo]

Друзья! Я согласен, что можно лучше и удобней, я по сравнению с вами чайник, я совсем не программист. Кто то может конкретно посоветовать удобный способ мулти-копировать и мулти-переносить файлы по линку (D:\My Pictures\NITAI\vidio\MVI_0029.avi). Так что бы в макросе:
1. Окно для выбора Папки куда скинуть
2. Окно перенести или копировать.

Заранее спасибо.

[SAS888]

Решение сделано с помощью стандартных диалоговых окон и FileSystemObject (чтобы не создавать собственных UserForm)
Будет задано три вопроса:
1. Выбрать файлы для копирования (перемещения).
2. Выбрать папку назначения.
3. Перемещать?
Если на последний вопрос ответить "Нет" - файлы будут скопированы.
P.S. По Вышей просьбе, код привожу здесь. Не забудьте подключить "Microsoft Scripting Runtime".

Sub CopyMove()

    Dim i As Long, a() As String, FilePath As String, PRD As String, PRM As String
    Dim fso As FileSystemObject, f
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "C:\"
        .Title = "Source files for copy/move"
        .AllowMultiSelect = True
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            ReDim a(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                a(i) = .SelectedItems(i)
            Next
        End If
    End With
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Destination folder"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            FilePath = .SelectedItems(1) & Application.PathSeparator
        End If
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    If MsgBox("Do you want to move the selected files?", vbYesNo + vbExclamation, "Move or Copy") = vbNo Then
        For i = 1 To UBound(a)
            Set f = fso.GetFile(a(i))
            f.Copy FilePath & Dir(a(i))
        Next
    Else
        For i = 1 To UBound(a)
            Set f = fso.GetFile(a(i))
            f.Move FilePath & Dir(a(i))
        Next
    End If
   
End Sub