Rename or move file function

[Guest]

I just can't get the code to work. I either get a syntax error or error '53'.
Can anyone see where i'm going wrong here. My goal is to rename a file based
on one cell matching another.

Option Compare Text
Sub CribSortingTest()

Dim s1, s2 As String
Dim x, y As Integer
x = 2
y = 1

Do While Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x,
1).Value <> ""
s1 = Cells(x, 3).Value
s2 = Cells(x, 4).Value

If Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x, 4).Value <>
"" Then
Name "D:\Documents and Settings\e345193\Desktop\Tools\" & s2 & ".doc" As
"D:\Documents and Settings\e345193\Desktop\Tools\New TCs\" & s1 & ".doc"
Else

End If

x = x + 1
s1 = ""
s2 = ""
Loop




End Sub

 

[Guest]

Sure you don't have your s1 and s2 reversed. S2 refers to column D and S1 to
column C. You refer to the existing name as column D and the new name is
column C. Is that the correct? If not, that could account for the 53 error
I would think.

also does the "New TCs" subdirectory already exist.

 

[Guest]

Yeah I'm sure that they are set up properly (s1 and s2 that is), and that New
TCs already exists.
What i think my problem may be is that there are some .docs missing. In the
spreadsheet records go up to about 1500, but there are no docs from about
1400 upwards.

Any way around this?

Cheers.

 

[Guest]

Option Compare Text
Sub CribSortingTest()

Dim s1, s2 As String
Dim x, y As Integer
x = 2
y = 1

Do While Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x,
1).Value <> ""
s1 = Cells(x, 3).Value
s2 = Cells(x, 4).Value

If Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x, 4).Value <>
"" Then
s21 = "D:\Documents and Settings\e345193\Desktop\Tools\" & s2 & ".doc"
s11 = "D:\Documents and Settings\e345193\Desktop\Tools\New TCs\" & s1 &
".doc"
if dir(s21) <> "" then
Name As s21 as s11
end if

Else

End If

x = x + 1
s1 = ""
s2 = ""
Loop




End Sub

 

[Guest]

Lovely job!

Thank you.

Option Compare Text
Sub CribSortingTest()

Dim s1, s2 As String
Dim x, y As Integer
x = 2
y = 1

Do While Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x,
1).Value <> ""
s1 = Cells(x, 3).Value
s2 = Cells(x, 4).Value

If Workbooks("NewCrib copy.xls").Worksheets("Sheet1").Cells(x, 4).Value <>
"" Then
s21 = "D:\Documents and Settings\e345193\Desktop\Tools\" & s2 & ".doc"
s11 = "D:\Documents and Settings\e345193\Desktop\Tools\New TCs\" & s1 &
".doc"
if dir(s21) <> "" then
Name As s21 as s11
end if

Else

End If

x = x + 1
s1 = ""
s2 = ""
Loop




End Sub