Excel - Можно ли сделать функцию перетаскивания для сохранения файлов непосредственно в папку?

Question

Я работаю над системой EDMS, которая должна быть создана в Excel. Может ли кто-нибудь уточнить, можно ли перетаскивать файлы непосредственно в путь к папке через Excel? Вместо того, чтобы обращаться к папкам постоянно, мои менеджеры проектов могли бы по-настоящему воспользоваться такой функцией.

С наилучшими пожеланиями, Себастьян

Answer 1

Sub MoveFiles()

    Dim xFd As FileDialog
    Dim xTFile As String
    Dim xExtArr As Variant
    Dim xExt As Variant
    Dim xSPath As String
    Dim xDPath As String
    Dim xSFile As String
    Dim xCount As Long

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.Title = "Please Select Original Folder:"

    If xFd.Show = -1 Then
        xSPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If

    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
    xFd.Title = "Please Select Destination folder:"

    If xFd.Show = -1 Then
        xDPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If

    If Right(xDPath, 1) <> "\" Then xDPath = xDPath + "\"
    xExtArr = Array("*.xlsm*", "*.Docx")

    For Each xExt In xExtArr
        xTFile = Dir(xSPath & xExt)

        Do While xTFile <> ""
            xSFile = xSPath & xTFile
            FileCopy xSFile, xDPath & xTFile
            Kill xSFile
            xTFile = Dir
            xCount = xCount + 1
        Loop
    Next
    MsgBox "Total number of moved files is: " & xCount, vbInformation, "Move File(S)"
End Sub

Как это устроено:

• Скопируйте и вставьте этот код как стандартный модуль.
• Запустить макрос.
• Он открывает проводник и предлагает выбрать оригинальную (исходную) папку.
• Выберите папку и нажмите ОК.
• Снова он предложит вам выбрать папку назначения.
• Нажмите Ok, скоро вы получите окно с сообщением, сколько файлов было скопировано.

Замечания:

• Эта строка является редактируемым Array("*.xlsm*", "*.Docx") , вы можете заменить File extensions другими, в соответствии с вашими потребностями.