Using an Excel sheet for batch delete

Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and just
matched on the actual file name. Clearly , when it moves them , it does
need to move the file to the destination folder with extension intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best if it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the transfer is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of 'Invalid
procedure Call Or Argument' after the last file at the line 'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found In
Source Path' when the routine runs? The routine could then run though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the present
routine does , and would mean it could ignore unfound files and just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the file
extension when checking if the file is present in the source folder?


Thanks again Per


Best Wishes

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In
Source Path' for everything , with or without extensions. I'm surprised
- it must be something with the extension logic. I tried it with no
extension and with extension in place , but it can't find either at the
moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and just
matched on the actual file name. Clearly , when it moves them , it does
need to move the file to the destination folder with extension intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best if it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the transfer is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of 'Invalid
procedure Call Or Argument' after the last file at the line 'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found In
Source Path' when the routine runs? The routine could then run though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the present
routine does , and would mean it could ignore unfound files and just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the file
extension when checking if the file is present in the source folder?


Thanks again Per


Best Wishes

Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine, but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In Source
Path' for everything , with or without extensions. I'm surprised - it must
be something with the extension logic. I tried it with no extension and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and just
matched on the actual file name. Clearly , when it moves them , it does
need to move the file to the destination folder with extension intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found In
Source Path' when the routine runs? The routine could then run though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the
file
extension when checking if the file is present in the source folder?


Thanks again Per


Best Wishes

HI Per

OK that's excellent - thanks very much.

I ran the routine and it works very neatly with files with extensions in
place , returning the correct 'Moved' or 'Not Found In Source Path' as
appropriate.

When I used it on filenames with no extension , it unfortunately reports
only 'Not Found In Source Path' for every file. This was even when the
files were clearly in the source path.

This apart , I think it's a very handy and useful routine.

Thank again for your expertise and time.



Best Wishes


Colin









In article , Per Jessen
writes
Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine, but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In Source
Path' for everything , with or without extensions. I'm surprised - it must
be something with the extension logic. I tried it with no extension and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and just
matched on the actual file name. Clearly , when it moves them , it does
need to move the file to the destination folder with extension intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found In
Source Path' when the routine runs? The routine could then run though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the
file
extension when checking if the file is present in the source folder?


Thanks again Per


Best Wishes

Hi Per

BTW the filenames don't have dots , so that shouldn't be an issue ,
although I can see why you would ask.

Also , is there a check to see if the user has entered identical source
and destination folder?

I know this shouldn't happen , but wondered what the routine would make
of the situation where the input to both source and destination popups
was identical.

Is there an error trap for this eventuality?



Best Wishes


Colin









In article , Colin Hayes
writes

HI Per

OK that's excellent - thanks very much.

I ran the routine and it works very neatly with files with extensions in
place , returning the correct 'Moved' or 'Not Found In Source Path' as
appropriate.

When I used it on filenames with no extension , it unfortunately reports
only 'Not Found In Source Path' for every file. This was even when the
files were clearly in the source path.

This apart , I think it's a very handy and useful routine.

Thank again for your expertise and time.



Best Wishes


Colin









In article , Per Jessen
writes
Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine, but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In Source
Path' for everything , with or without extensions. I'm surprised - it must
be something with the extension logic. I tried it with no extension and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and just
matched on the actual file name. Clearly , when it moves them , it does
need to move the file to the destination folder with extension intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
.. .

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found In
Source Path' when the routine runs? The routine could then run though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the
file
extension when checking if the file is present in the source folder?


Thanks again Per


Best Wishes

Hi Colin

Thanks for your reply

Now it should also move files without file extensions.

It also test if Source path is equal to Destination path. If that is the
case the user will be notified and the macro stop.
Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If

If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

If SourcePath = DestPath Then
msg = MsgBox("Source path is equal to destionation path" & _
vbLf & vbLf & "Ending macro !", vbCritical, "Warning !")
Exit Sub
End If

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If Not IsNumeric(ext) Then
FileToMove = FileToMove & "." & ext
End If
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...



Hi Per

BTW the filenames don't have dots , so that shouldn't be an issue ,
although I can see why you would ask.

Also , is there a check to see if the user has entered identical source
and destination folder?

I know this shouldn't happen , but wondered what the routine would make of
the situation where the input to both source and destination popups was
identical.

Is there an error trap for this eventuality?



Best Wishes


Colin









In article , Colin Hayes
writes

HI Per

OK that's excellent - thanks very much.

I ran the routine and it works very neatly with files with extensions in
place , returning the correct 'Moved' or 'Not Found In Source Path' as
appropriate.

When I used it on filenames with no extension , it unfortunately reports
only 'Not Found In Source Path' for every file. This was even when the
files were clearly in the source path.

This apart , I think it's a very handy and useful routine.

Thank again for your expertise and time.



Best Wishes


Colin









In article , Per Jessen
writes
Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine,
but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In
Source
Path' for everything , with or without extensions. I'm surprised - it
must
be something with the extension logic. I tried it with no extension and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I
run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and
just
matched on the actual file name. Clearly , when it moves them , it
does
need to move the file to the destination folder with extension
intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best
if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to
take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the
transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
. ..

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found
In
Source Path' when the routine runs? The routine could then run
though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and
just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the
file
extension when checking if the file is present in the source
folder?


Thanks again Per


Best Wishes

HI Per

OK that's excellent now , and makes a very useful app.

I do find it won't move files without extension , but it's no big
problem as It does work well for those which do have an extension. It
also does trap input error where identical source and destination paths
were entered.

Thanks again Per - I'm very grateful for your time and expertise.



Best Wishes


Colin










In article , Per Jessen
writes
Hi Colin

Thanks for your reply

Now it should also move files without file extensions.

It also test if Source path is equal to Destination path. If that is the
case the user will be notified and the macro stop.
Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If

If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

If SourcePath = DestPath Then
msg = MsgBox("Source path is equal to destionation path" & _
vbLf & vbLf & "Ending macro !", vbCritical, "Warning !")
Exit Sub
End If

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If Not IsNumeric(ext) Then
FileToMove = FileToMove & "." & ext
End If
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...



Hi Per

BTW the filenames don't have dots , so that shouldn't be an issue ,
although I can see why you would ask.

Also , is there a check to see if the user has entered identical source
and destination folder?

I know this shouldn't happen , but wondered what the routine would make of
the situation where the input to both source and destination popups was
identical.

Is there an error trap for this eventuality?



Best Wishes


Colin









In article , Colin Hayes
writes

HI Per

OK that's excellent - thanks very much.

I ran the routine and it works very neatly with files with extensions in
place , returning the correct 'Moved' or 'Not Found In Source Path' as
appropriate.

When I used it on filenames with no extension , it unfortunately reports
only 'Not Found In Source Path' for every file. This was even when the
files were clearly in the source path.

This apart , I think it's a very handy and useful routine.

Thank again for your expertise and time.



Best Wishes


Colin









In article , Per Jessen
writes
Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine,
but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In
Source
Path' for everything , with or without extensions. I'm surprised - it
must
be something with the extension logic. I tried it with no extension and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
.. .


Hi Per

OK Thanks for that. I tried it out , and it works perfectly. Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I
run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and
just
matched on the actual file name. Clearly , when it moves them , it
does
need to move the file to the destination folder with extension
intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed. Best
if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to
take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the
transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
.. .

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found
In
Source Path' when the routine runs? The routine could then run
though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and
just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore the
file
extension when checking if the file is present in the source
folder?


Thanks again Per


Best Wishes

Hi Colin

Thanks for your reply.

I'm glad to help.

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK that's excellent now , and makes a very useful app.

I do find it won't move files without extension , but it's no big problem
as It does work well for those which do have an extension. It also does
trap input error where identical source and destination paths were
entered.

Thanks again Per - I'm very grateful for your time and expertise.



Best Wishes


Colin










In article , Per Jessen
writes
Hi Colin

Thanks for your reply

Now it should also move files without file extensions.

It also test if Source path is equal to Destination path. If that is the
case the user will be notified and the macro stop.
Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If

If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

If SourcePath = DestPath Then
msg = MsgBox("Source path is equal to destionation path" & _
vbLf & vbLf & "Ending macro !", vbCritical, "Warning !")
Exit Sub
End If

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If Not IsNumeric(ext) Then
FileToMove = FileToMove & "." & ext
End If
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...



Hi Per

BTW the filenames don't have dots , so that shouldn't be an issue ,
although I can see why you would ask.

Also , is there a check to see if the user has entered identical source
and destination folder?

I know this shouldn't happen , but wondered what the routine would make
of
the situation where the input to both source and destination popups was
identical.

Is there an error trap for this eventuality?



Best Wishes


Colin









In article , Colin Hayes
writes

HI Per

OK that's excellent - thanks very much.

I ran the routine and it works very neatly with files with extensions in
place , returning the correct 'Moved' or 'Not Found In Source Path' as
appropriate.

When I used it on filenames with no extension , it unfortunately reports
only 'Not Found In Source Path' for every file. This was even when the
files were clearly in the source path.

This apart , I think it's a very handy and useful routine.

Thank again for your expertise and time.



Best Wishes


Colin









In article , Per Jessen
writes
Hi Colin

This version should copy both files with and without file extensions.

Does the filename contain any dots. If so that may confuse the routine,
but
I will try to find a solution for that.

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.GetExtensionName(FileToMove) = "" Then
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For c = 1 To .FoundFiles.Count
TargetFile = .FoundFiles(c)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Exit For
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Else
Debug.Print fs.GetExtensionName(FileToMove) & " " & FileToMove
If fs.fileexists(FileToMove) = True Then
fs.MoveFile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End If
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Regards,
Per

"Colin Hayes" skrev i meddelelsen
...

HI Per

OK thanks for this.

It gives a puzzling outcome now I find - it just says 'Not Found In
Source
Path' for everything , with or without extensions. I'm surprised - it
must
be something with the extension logic. I tried it with no extension
and
with extension in place , but it can't find either at the moment...



Best Wishes


Colin











In article , Per Jessen
writes
Hi Colin

This should do it:

Sub test1()
Range("B2", Range("B2").End(xlDown)).ClearContents

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
With Application.FileSearch
.NewSearch
.LookIn = SourcePath
.SearchSubFolders = False
.Filename = FileToMove
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
TargetFile = .FoundFiles(1)
ext = fs.GetExtensionName(TargetFile)
If fs.fileexists(FileToMove & "." & ext) = True Then
fs.MoveFile FileToMove & "." & ext, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Else
Cells(r, "B") = "Not Found In Source Path"
End If
End With
Next
Set fs = Nothing
Columns("B:B").EntireColumn.AutoFit
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
. ..


Hi Per

OK Thanks for that. I tried it out , and it works perfectly.
Thanks.

On the points you make :

C - My list of filenames in column A have no file extension. When I
run
the routine it does not find them in the source folder.

When I add the file extension , it finds them.

It would be helpful if it ignored files extensions altogether and
just
matched on the actual file name. Clearly , when it moves them , it
does
need to move the file to the destination folder with extension
intact.

Perhaps a .* command could do this.

My list could have hundreds of filenames , and to have to add the
extension before running the routine would be laborious indeed.
Best
if
it
could just ignore extensions completely , if it is possible.

D - Yes it would an idea to clear column B and make wide enough to
take
the text.


Thanks again Per - I'm very grateful.



Best Wishes


Colin





In article , Per Jessen
writes
Hi Colin

This should cover A and B.

C. Do you want the routine always to look up the file extension, or
should
we first check if the filename include an file extension ?

D. Should I include at statement to clear column B before the
transfer
is
started ?

Sub test()

Set fs = CreateObject("Scripting.FileSystemObject")

SourcePath = InputBox("Enter source path : ")
If SourcePath = "" Then Exit Sub

sExists:
If fs.FolderExists(SourcePath) = False Then
SourcePath = InputBox("The path " & SourcePath & " don't exists"
_
& vbLf & vbLf & "Enter path : ")
GoTo sExists
End If
If Right(SourcePath, 1) "\" Then SourcePath = SourcePath & "\"

DestPath = InputBox("Enter destination path : ")
If DestPath = "" Then Exit Sub
dExists:
If fs.FolderExists(DestPath) = False Then
DestPath = InputBox("The path " & DestPath & " don't exists" _
& vbLf & vbLf & "Enter path : ")
GoTo dExists
End If
If Right(DestPath, 1) "\" Then DestPath = DestPath & "\"

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
FileToMove = SourcePath & Cells(r, "A").Value
If fs.fileexists(FileToMove) = True Then
fs.movefile FileToMove, DestPath
Cells(r, "B") = "Moved"
Else
Cells(r, "B") = "Not Found In Source Path"
End If
Next
Set fs = Nothing
End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
. ..

Hi Per

OK I tried it out and it works fine. Thank you - I'm grateful.

Here is what happened here :

A. It moved the files in my list , but it does give an error of
'Invalid
procedure Call Or Argument' after the last file at the line
'fs.movefile
fToMove, DestPath'.


B. Also , where a filename in column A is not found in the source
folder
,
the whole program stops.

In column B , could each filename be marked 'Moved' or 'Not Found
In
Source Path' when the routine runs? The routine could then run
though
smoothly from top to bottom without stopping.

This would be better than removing the file from the list as the
present
routine does , and would mean it could ignore unfound files and
just
mark
in column be the success or failure of the Move.


C. Do you think too , that the routine could be made to ignore
the
file
extension when checking if the file is present in the source
folder?


Thanks again Per


Best Wishes

Does this work if you have the file extention listed in the file name or
spaces in the name? I need to delete .aac & .wma files. Also, can you run
through sub folders? Meaning, I have 200 folders (albums) and I already have
the list, I need to delete the files within the folders.

Directory is: C:\Documents and Settings\My Documents\My Music
Sub Directory: C:\Documents and Settings\\My Documents\My Music\50 Cent
File name: 01 01 Track 1 Unknown Artist Unknown Album (4-24-2008 8-04-25
AM).wma

"Per Jessen" wrote:

Hi

Try this:

Sub test()
MyPath = "c:\temp\"
Set fs = CreateObject("Scripting.FileSystemObject")

LastRow = Range("A1").End(xlDown).Row

For r = 2 To LastRow
fs.DeleteFile MyPath & Cells(r, "A").Value
Cells(r, "A").ClearContents ' Remove file from list after deleting it
Next

End Sub

Best regards,
Per

"Colin Hayes" skrev i meddelelsen
news

HI All

I have an Excel worksheet with a list of file names in column A.

I'd like to use this list to look into a named directory (perhaps built in
to the routine , or entered via a popup) and delete files of the same name
in turn.

Once a file is deleted , then the routine would go back to Excel and look
up the next file name in the column for the next delete , and so on until
it reaches the end of the list.

Can someone help with this , please?

Grateful for any advice.



Best Wishes