Я хочу скопировать файлы из одного места в другое, основываясь на значении ячейки Excel. столбец b содержит имя файла; столбец c содержит путь SOurce, а столбец D содержит путь назначения. Пожалуйста, помогите очистить ошибку, мой код ниже.

Public Sub file_copy()
'Declare Variables
 Dim FSO As Object
 Dim sFolder As String
 Dim dNGFolder As String
 Dim ws As Worksheet

'This is Your File Name which you want to Copy
 'set worksheet:
    Set ws = ThisWorkbook.Sheets("Main")

'Order no's entered in column A - determine last data row in column A of the worksheet:
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

'loop through all cells in column A:
    For i = 3 To lastRow

'Source folder locations
 sFolder = ws.Cells(i, 3)     'Extracted file Location


'Destination folders
 dFolder = ws.Cells(i, 4)   'Destination Location


'Create Object
 Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
 If Not FSO.FileExists(sFolder) Then
 MsgBox "Specified File Not Found", vbInformation, "Error Message"

'Copying If the Same File is Not Located in the Destination Folder

  On Error Resume Next
  FSO.CopyFile sFolder & ws.Cells(i, 2), dFolder, True

  End If

  Next i
  MsgBox "Specified File Copied Successfully", vbInformation, "COMPLETED"
  End Sub

1 ответ1

0
Sub file_copy()
 'Declare Variables
  Dim FSO As Object
  Dim sFolder As String
  Dim dFolder As String
  Dim ws As Worksheet

     'This is Your File Name which you want to Copy
     'set worksheet:
          Set ws = ThisWorkbook.Sheets("Main")

 'Order no's entered in column A - determine last data row in column A of the Worksheet:
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

'loop through all cells in column A:
For i = 3 To lastRow

'Source folder locations
 sFolder = ws.Cells(i, 4)     


'Destination folders
 dFolder = ws.Cells(i, 5)   


'Create Object
   Set FSO = CreateObject("Scripting.FileSystemObject")

 'Checking If File Is Located in the Source Folder
    If Not FSO.FileExists(sFolder & ws.Cells(i, 2)) = True Then
    MsgBox "Specified File Not Found", vbInformation, "Error Message"
  End If

 'Copying If the Same File is Not Located in the Destination Folder

  'On Error Resume Next
      If FSO.FileExists(sFolder & ws.Cells(i, 2)) = True Then
      FSO.CopyFile sFolder & ws.Cells(i, 2), dFolder, True

  End If

   Next i
    MsgBox "Copied successfully", vbInformation, "COMPLETED"
    End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .