Question

我正在尝试重新配置VBA代码，以便它通过列表而不是列表中的单行。

目前代码的工作方式与我想要的完全相同，但我无法弄清楚循环，以便它为我处理整个列表。

你有什么建议吗？代码Code attached

修改

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 Until 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

从单行到列表（循环）

2 个答案: