从单行到列表（循环）

我正在尝试重新configurationVBA代码，以便它通过一个列表而不是我的列表中的一行。

目前代码的工作方式正是我想要的，但是我很难找出循环，所以它为我处理整个列表。

你有什么build议吗？ 代码见下面的代码

编辑：

Sub sbCopyingAFileReadFromSheet() 'Declaration Dim FSO Dim sFile As String Dim sSFolder As String Dim sDFolder As String Dim sFilenew As String 'This is Your File Name which you want to Copy.You can change File name at B5. sFile = Sheets("Main").Range("F5") 'Change to match the source folder path. You can change Source Folder name at B6. sSFolder = Sheets("Main").Range("B5") 'Change to match the destination folder path. You can change Destination Folder name at B6. sDFolder = Sheets("Main").Range("C5") 'Change name to new file name. sFilenew = Sheets("Main").Range("D5") 'Create Object for File System Set FSO = CreateObject("Scripting.FileSystemObject") 'Checking If File Is Located in the Source Folder If Not FSO.FileExists(sSFolder & sFile) Then MsgBox "Specified File Not Found in Source Folder Error 2", vbInformation, "Not Found" 'Copying If the Same File is Not Located in the Destination Folder ElseIf Not FSO.FileExists(sDFolder & sFile) Then FSO.CopyFile (sSFolder & sFile), (sDFolder & sFilenew), True MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!" Else MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists" End If End Sub 

Answer 1

使用Do直到IsEmpty循环，易于理解。

  Set FSO = CreateObject("Scripting.FileSystemObject") iRow = 5 ' start from row 5 With Worksheets("Sheet1") '<-- update sheet name Do Until IsEmpty(.Cells(iRow, 6)) ' (Row, Column) sFile = .Cells(iRow, 6).Value sSFolder = .Cells(iRow, 2).Value sDFolder = .Cells(iRow, 3).Value sFilenew = .Cells(iRow, 4).Value 'Checking If File Is Located in the Source Folder If Not FSO.FileExists(sSFolder & sFile) Then Debug.Print "Specified File Not Found in Source Folder Error 2", vbInformation, "Not Found" 'Print on Immediate ' MsgBox "Specified File Not Found in Source Folder Error 2", vbInformation, "Not Found" 'Copying If the Same File is Not Located in the Destination Folder ElseIf Not FSO.FileExists(sDFolder & sFile) Then FSO.CopyFile (sSFolder & sFile), (sDFolder & sFilenew), True ' MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!" Debug.Print "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!" 'Print on Immediate Else ' MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists" Debug.Print "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists" 'Print on Immediate End If iRow = iRow + 1 Loop End With 

Answer 2

尝试：

 Sub sbCopyingAFileReadFromSheet() 'Declaration Dim FSO Dim sFile As String Dim sSFolder As String Dim sDFolder As String Dim sFilenew As String Dim i As Long, Lr As Long 'Create Object for File System Set FSO = CreateObject("Scripting.FileSystemObject") Lr = 10 'Change this to your needs For i = 5 To Lr 'This is Your File Name which you want to Copy.You can change File name at B5. sFile = Sheets("Main").Range("F" & i) 'Change to match the source folder path. You can change Source Folder name at B6. sSFolder = Sheets("Main").Range("B" & i) 'Change to match the destination folder path. You can change Destination Folder name at B6. sDFolder = Sheets("Main").Range("C" & i) 'Change name to new file name. sFilenew = Sheets("Main").Range("D" & i) 'Checking If File Is Located in the Source Folder If Not FSO.FileExists(sSFolder & sFile) Then MsgBox "Specified File Not Found in Source Folder Error 2", vbInformation, "Not Found" 'Copying If the Same File is Not Located in the Destination Folder ElseIf Not FSO.FileExists(sDFolder & sFile) Then FSO.CopyFile (sSFolder & sFile), (sDFolder & sFilenew), True MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!" Else MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists" End If Next End Sub