vba wscript.shell 根据单元格路径或文件名将文件从文件夹复制到另一个文件夹

Question

我想用 vba wscript.shell 来做，因为复制文件更快，我想根据列中的选择，根据 excel 单元格中的路径或文件名复制文件“E”并使用“msoFileDialogFolderPicker”输出目标文件夹

我有示例代码，但需要更改。



Sub copy()
xDFileDlg As FileDialog
xDPathStr As Variant
sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir C:\copy\*.* /b /s").stdout.readall, vbCrLf), "\")
'For j = 0 To UBound(sn)
'If DateDiff("d", FileDateTime(sn(j)), Date) > 30 Then sn(j) = ""
'Next

sn = Filter(sn, "\")

For j = 0 To UBound(sn)
FileCopy sn(j), "C:\destcopy" & Mid(sn(j), 2)
Next
 Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
 xDFileDlg.Title = "Please select the destination folder:"
 If xDFileDlg.Show <> -1 Then Exit Sub
 xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
End Sub

谢谢

罗伊

Answer 1

请测试下一个代码。它假定您需要 select 目标文件夹以复制那里的所有文件。否则，VBScript 对象节省的几毫秒对于浏览要复制的每个文件目标文件夹所需的秒数来说太少了。但是，如果这是你想要的，我可以很容易地调整代码来做到这一点：

Sub copyFiles()
  Dim sh As Worksheet, lastR As Long, arrA, i As Long, k As Long
  Dim fileD As FileDialog, strDestFold As String, FSO As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row ' last row on A:A column
  arrA = sh.Range("A2:E" & lastR).Value2                   'place the range in an array for faster iteration
  Set FSO = CreateObject("Scripting.FileSystemObject")
  With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select the destination folder!"
        .AllowMultiSelect = False
        If .Show = -1 Then
            strDestFold = .SelectedItems.Item(1) & "\"   'select the destination folder
        End If
  End With
  If strDestFold = "" Then Exit Sub                         'in case of  not selecting any folder
  For i = 1 To UBound(arrA)
     If UCase(arrA(i, 5)) = "V" Then                         'copy the file only if a "V" exists in column E:E
        If FSO.FileExists(arrA(i, 1)) Then                    'check if the path in excel is correct
            FSO.CopyFile arrA(i, 1), strDestFold, True     'copy the file (True, to overwrite the file if it exists)
            k = k + 1
        Else
            MsgBox arrA(i, 1) & " file could not be found." & vbCrLf & _
                        "Please, check the spelling and correct the file full path!", vbInformation, _
                        "File does not exist..."
        End If
     End If
  Next i
  MsgBox "Copied " & k & " files in " & strDestFold, , "Ready..."
End Sub

vba wscript.shell 根据单元格路径或文件名将文件从文件夹复制到另一个文件夹

vba wscript.shell copy file from folder to another folder based on cell path or filename

arrays

vba

wscript.shell

filecopy