changing file names

[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

 

[Dave Peterson]

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

 

[saybut]

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.