changing file names

  • Thread starter Thread starter saybut
  • Start date Start date
S

saybut

Hi, I was wondering if anyone can help?

A while ago someone was very helpful in answering a question for me on
here. I needed a macro which looked at the file names in column A and
changed them to the corresponding file name in column b.

The macro is a bit temperamental and now doesn't really seem to work at
all. I think its something to do with the way the names in column b are
presented i.e. using certain numbers or letters seems to mess it up.
(the problem is that excel claims the file name already exists after
changing about 10-15 names)

The code is below, if anyone has any idea on this it would be a great
help. I've put example file names below the code.

many thanks.



Sub RenameMyData()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim c As Range
Dim sOld As String, sNew As String, sExt As String

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\TOCS\")
For Each oFile In oFolder.Files
sOld = Left(oFile.Name, InStr(1, oFile.Name, ".") - 1)
sExt = Right(oFile.Name, Len(oFile.Name) - InStr(1, oFile.Name, "."))
On Error Resume Next
Set c = Cells.Find(what:=sOld, LookIn:=xlValues)
On Error GoTo 0
If Not c Is Nothing Then
oFile.Name = c.Offset(0, 1).Value & "." & sExt
End If
Next


Eg File Name:

COL A [/B] COL B
NewLink LS03101
Pevion LS03102
Interpharm LS03103
 
I think I'd drop the FSO stuff and just use tools built into excel's VBA:

Option Explicit
Sub testme()
Dim TestStr As String
Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim myPath As String

myPath = "C:\TOCS\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

Set wks = Worksheets("sheet1")

With wks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))

'column C used for messages
myRng.Offset(0, 2).ClearContents

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" _
Or Trim(myCell.Offset(0, 1).Value) = "" Then
myCell.Offset(0, 2).Value = "Invalid Name"
Else
TestStr = ""
On Error Resume Next
TestStr = Dir(myPath & myCell.Value)
On Error GoTo 0
If TestStr = "" Then
myCell.Offset(0, 2).Value = "Missing File"
Else
On Error Resume Next
Name myPath & myCell.Value As myPath _
& myCell.Offset(0, 1).Value
If Err.Number <> 0 Then
myCell.Offset(0, 2).Value = "Error renaming file!"
Err.Clear
End If
End If
End If
Next myCell
End With
End Sub
Hi, I was wondering if anyone can help?

A while ago someone was very helpful in answering a question for me on
here. I needed a macro which looked at the file names in column A and
changed them to the corresponding file name in column b.

The macro is a bit temperamental and now doesn't really seem to work at
all. I think its something to do with the way the names in column b are
presented i.e. using certain numbers or letters seems to mess it up.
(the problem is that excel claims the file name already exists after
changing about 10-15 names)

The code is below, if anyone has any idea on this it would be a great
help. I've put example file names below the code.

many thanks.

Sub RenameMyData()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim c As Range
Dim sOld As String, sNew As String, sExt As String

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\TOCS\")
For Each oFile In oFolder.Files
sOld = Left(oFile.Name, InStr(1, oFile.Name, ".") - 1)
sExt = Right(oFile.Name, Len(oFile.Name) - InStr(1, oFile.Name, "."))
On Error Resume Next
Set c = Cells.Find(what:=sOld, LookIn:=xlValues)
On Error GoTo 0
If Not c Is Nothing Then
oFile.Name = c.Offset(0, 1).Value & "." & sExt
End If
Next

Eg File Name:

COL A [/B] COL B
NewLink LS03101
Pevion LS03102
Interpharm LS03103
Click to expand...
 
Hi,

thats brilliant Dave, thank you so much.

I've just started properly learning vb the other day and don't know
that kind of stuff yet. hopefully I will soon though.

thanks again.
 
Back
Top