Modify my code to continue even if the file is not found

[rjwalters]

Ok so I have this code, and it works great AS long as the file is available. What is happening is when I select go, it looks in column A for the file name, then goes to the folder where the file is(Column B), and moves it to a new folder(Column C).


The problem is that if the file is not found, it errors out and will not move onto the next file. I can not figure out how to get it to move on if the file is not found.


Any thoughts?


I hope I put the code in the backtick right....

[pre]

Sub Filemover()
Dim sPath As String, dPath As String, fn As String, sFN As String, dFN As String
Dim r As Range, c As Range
Range("A2").Activate

Set r = ActiveWorkbook.ActiveSheet.Range("A2")
Do Until IsEmpty(ActiveCell)
sPath = ActiveCell.Offset(, 1).Value2 & ""
dPath = ActiveCell.Offset(, 2).Value2 & ""
fn = "*" & ActiveCell.Value2 & ".mef3"
sFN = sPath & fn
dFN = dPath & fn
ActiveCell.Value = (Dir(sFN))
ActiveCell.Offset(1, 0).Activate
Loop

Dim Cell As Range
Dim Filename As String
Dim Filepath As String
Dim NewPath As String
Dim Rng As Range
Dim RngEnd As Range
Dim Wks As Worksheet

Set Wks = ActiveSheet

Set Rng = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)

For Each Cell In Rng
Filename = Cell()
Filepath = Cell.Offset(0, 1)
NewPath = Cell.Offset(0, 2)
Name Filepath & "" & Filename As NewPath & "" & Filename
Next Cell

End Sub

[/pre]

 

[Luke M]

Wasn't sure if you wanted an error message, but you could use the Dir function at the end like this:

[pre]

Sub Filemover()
Dim sPath As String, dPath As String, fn As String, sFN As String, dFN As String
Dim r As Range, c As Range
Range("A2").Activate

Set r = ActiveWorkbook.ActiveSheet.Range("A2")
Do Until IsEmpty(ActiveCell)
sPath = ActiveCell.Offset(, 1).Value2 & ""
dPath = ActiveCell.Offset(, 2).Value2 & ""
fn = "*" & ActiveCell.Value2 & ".mef3"
sFN = sPath & fn
dFN = dPath & fn
ActiveCell.Value = (Dir(sFN))
ActiveCell.Offset(1, 0).Activate
Loop

Dim Cell As Range
Dim Filename As String
Dim Filepath As String
Dim NewPath As String
Dim Rng As Range
Dim RngEnd As Range
Dim Wks As Worksheet

Set Wks = ActiveSheet

Set Rng = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)

For Each Cell In Rng
Filename = Cell()
Filepath = Cell.Offset(0, 1)
NewPath = Cell.Offset(0, 2)
If Dir(Filepath & "" & Filename) = "" Then
MsgBox "File does not exist"
Else
Name Filepath & "" & Filename As NewPath & "" & Filename
End If
Next Cell

End Sub

[/pre]

 

[rjwalters]

I tried it but it still does the same thing. What happens is when it does not find a file, it wont move any files after that. I did not get the message box either.

 

[imla]

Try this it may do your work!

[pre]

Option Explicit
Sub Filemover()
Dim sPath As String, dPath As String, sFN As String
Dim r As Range

Set r = Range("A2")
Do Until IsEmpty(r)
sPath = r.Offset(, 1).Value2 & ""
dPath = r.Offset(, 2).Value2 & ""
sFN = Dir(sPath & "*" & r.Value2 & ".mef3")
r.Value = sFN
If sFN <> "" Then
Name sPath & sFN As dPath & sFN
End If
Set r = r.Offset(1, 0)
Loop
End Sub

[/pre]