Как сохранить разные файлы, перечисленные в столбце Excel, как путь к файлу в другом месте - PullRequest
Новая
       22

Как сохранить разные файлы, перечисленные в столбце Excel, как путь к файлу в другом месте

0 голосов
/ 10 июня 2019

Допустим, у меня есть список путей к файлам в столбце Excel BD.Как использовать команду VBA, чтобы выбрать все пути к файлам в столбце BD и сохранить их в любом месте, где я хочу?

Я не смог найти никаких руководств по этому вопросу.

Это было самое близкое:

https://www.youtube.com/watch?v=pHFucY4VMT4

Но я думаю, что это ограничено Excel и определенным путем к файлу.

Буду признателен за любой простой в использовании совет по коду здесь!Новичок в VBA, поэтому, пожалуйста, не слишком сильно меня трэшите: P

PS Я пробовал это, но получаю сообщение об ошибке: 

Private Sub CommandButton8_Click()

Option Explicit
Sub CopyFiles()
' (1) requires a reference to the object library "Microsoft Scripting Runtime" under Options > Tools > References in the VBE.

    Dim FSO As Scripting.FileSystemObject
    Dim DesPath As String
    Dim C As Range
    Dim LastRow As Long
    Set FSO = New Scripting.FileSystemObject
'your destination path
    DesPath = "C:\"
    With ThisWorkbook.Sheets("MySheet") 'change MySheet for your sheet name
        LastRow = .Cells(.Rows.Count, "BD").End(xlUp).Row 'last row on column BD
        For Each C In .Range("BD2:BD" & LastRow) 'loop through all the cells from 2 to LastRow
            If Not C = vbNullString Then 'check that the cell isn't blank
                FSO.CopyFile C.Value, DesPath, True 'True means overwrite
            End If
        Next C
    End With




End Sub

Полученное сообщение об ошибке «Ошибка компиляции:Недопустимая внутренняя процедура "

Эта ошибка выделяется желтым цветом этой команды VBA:" Private Sub CommandButton8_Click () "

1 Ответ

0 голосов
/ 10 июня 2019

Вы можете использовать FileSystemObject следующим образом: 

Option Explicit
Sub CopyFiles()
' (1) requires a reference to the object library "Microsoft Scripting Runtime" under Options > Tools > References in the VBE.

    Dim FSO As Scripting.FileSystemObject
    Dim DesPath As String
    Dim C As Range
    Dim LastRow As Long
    Set FSO = New Scripting.FileSystemObject

    DesPath = "C:\Test\" 'your destination path
    With ThisWorkbook.Sheets("MySheet") 'change MySheet for your sheet name
        LastRow = .Cells(.Rows.Count, "BD").End(xlUp).Row 'last row on column BD
        For Each C In .Range("BD2:BD" & LastRow) 'loop through all the cells from 2 to LastRow
            If Not C = vbNullString Then 'check that the cell isn't blank
                FSO.CopyFile C.Value, DesPath, True 'True means overwrite
            End If
        Next C
    End With

End Sub
...