Перемещение файлов в другой каталог - PullRequest
0 голосов
/ 24 февраля 2020

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

Я знаю, как сделать это для каждого файла, как показано ниже:

enter image description here

Как мне сделать это для целых столбцов, хотя?

Sub Copy_One_File()
  FileCopy "C:\Users\Ron\SourceFolder\Test.xls", "C:\Users\Ron\DestFolder\Test.xls"
End Sub

Sub Move_Rename_One_File()
  'You can change the path and file name
  Name "C:\Users\Ron\SourceFolder\Test.xls" As "C:\Users\Ron\DestFolder\TestNew.xls"
End Sub

Ответы [ 2 ]

1 голос
/ 24 февраля 2020

Если эти 3 столбца являются столбцами «A», «B» и «C», этот код, вероятно, должен работать.

Sub move_files()
  Dim i As Long
  With ActiveSheet
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
      Err.Clear
      On Error Resume Next
      Name (.Cells(i, 1)) As .Cells(i, 2) & "\" & StrReverse(Split(StrReverse(.Cells(i, 1)), "\")(0))
      If Err = 0 Then .Cells(i, 3) = "YES" Else .Cells(i, 3) = "NO"
      On Error GoTo 0
    Next
  End With
End Sub

0 голосов
/ 24 февраля 2020

Попробуйте этот код, пожалуйста ...

Sub testCopyFiles()
 Dim sh As Worksheet, lastRow As Long, i As Long, destPath As String
 Dim fN As String, fileName As String
 Set sh = ActiveSheet
 lastRow = sh.Range("A" & Cells.Rows.count).End(xlUp).row

 For i = 2 To lastRow
    fN = sh.Range("A" & i).Value
    destPath = sh.Range("B" & i).Value & "\" & _
                Right(fN, Len(fN) - InStrRev(fN, "\"))
    FileCopy sh.Range("A" & i).Value, destPath
    sh.Range("C" & i).Value = "Yes"
 Next i
End Sub
...