将文件移至 VBA
MOVE FILE IN VBA
我希望下面的代码使用 2 种方法。第一种方法是复制文件,第二种方法是移动文件。对于方法 1,我做了一个评论,以便执行方法 2,但它不起作用,这是一个错误。
Sub movecopyFiles()
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)
FSO.moveFILE arrA(i, 1), strDestFold, True 'move the file (True, to overwrite the file if it exists) >> error this line
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
请将以下部分改写为:
Dim fileName As String 'new variable to be declared
'your existing code...
If FSO.FileExists(arrA(i, 1)) Then 'check if the path in excel is correct
fileName = Right(arrA(i, 1), Len(arrA(i, 1)) - InStrRev(arrA(i, 1), "\"))
If FSO.FileExists(strDestFold & fileName) Then Kill strDestFold & fileName 'delete file if exists
FSO.MoveFile arrA(i, 1), strDestFold 'move the file
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
'your existing code
我希望下面的代码使用 2 种方法。第一种方法是复制文件,第二种方法是移动文件。对于方法 1,我做了一个评论,以便执行方法 2,但它不起作用,这是一个错误。
Sub movecopyFiles()
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)
FSO.moveFILE arrA(i, 1), strDestFold, True 'move the file (True, to overwrite the file if it exists) >> error this line
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
请将以下部分改写为:
Dim fileName As String 'new variable to be declared
'your existing code...
If FSO.FileExists(arrA(i, 1)) Then 'check if the path in excel is correct
fileName = Right(arrA(i, 1), Len(arrA(i, 1)) - InStrRev(arrA(i, 1), "\"))
If FSO.FileExists(strDestFold & fileName) Then Kill strDestFold & fileName 'delete file if exists
FSO.MoveFile arrA(i, 1), strDestFold 'move the file
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
'your existing code