Sub test()
Dim FileN(), k%
cPath = "C:\TS\"
myFile = Dir(cPath, vbDirectory)
k = -1
Do While myFile <> ""
If InStr(myFile, ".") = 0 Then
k = k + 1
ReDim Preserve FileN(k)
FileN(k) = myFile
End If
myFile = Dir
Loop
If k < 0 Then Exit Sub
For i = 1 To [a65536].End(xlUp).Row
If Cells(i, 1) <> "" Then
For j = 0 To k
cFile = cPath & FileN(j) & "\" & Cells(i, 1)
If Dir(cFile) <> "" Then
FileCopy cFile, "C:\TS-TODAY\" & Dir(cFile)
Exit For
End If
Next
End If
Next
End Sub
上述代码必须确保A列所列文件名已经包含了扩展名,如果没有扩展名,则要不修改A列内容,要不就修改19行语句。如果扩展名都一样,则在19行的Cells(i,1)修改为Cells(i,1) & ".xls";如果扩展名不一样,则修改为Cells(i,1) & ".*"