Interesting File Rename and Processing! 1

[proximity]

Hi,

I'm struggling a bit with this, so any help much appreciated, as always!

Ok, I have a sequence of files with the following naming convention, stored in drive R:\

prtx010.prtx010.0539.888888.465.19222990
prtx010.prtx010.0539.111111.466.19222819
prtx010.prtx010.0539.222222.322.19222801
prtx010.prtx010.0539.123456.815.19222820

None of these files have an extension but can be renamed as .txt files and manipulated accordingly. Currently, I rename them by hand and import into access. Not a big job with two or three files, but a pain with larger numbers!

The first 21 characters are the same for every file created and do not ever change. What I want to do is rename them with characters 22 to 27 (6 digit numbers) like this:

prtx010.prtx010.0539.123456.465.19222820 becomes 123456.txt
prtx010.prtx010.0539.123456.465.19222820 becomes 111111.txt and so on until all files in the directory have been renamed.

Any ideas?

--
Steven

 

[jadams0173]

As long as your file name remains the same length and you starting and ending point for you new file name doesn't change(which it doesn't sound like it will) then this will get you desired file name.

Function testthis()
Dim a As String
Dim newname As String


a = "prtx010.prtx010.0539.123456.815.19222820"
newname = Mid(a, 22, Len(a) - 34) & ".txt"
Debug.Print newname


End Function

Are you leaving the new files on the R Drive? One way to rename them would be to use FileCopy function or maybe the file system object. There is a Rename function in access but help says it only renames objects.

I tried to have patience but it took to long! -DW

 

[proximity]

Hi,

Many thanks for the example code - it works a treat. I am having a go at the re-naming side of it now. I have used SourceFile, DestinationFile in the past, so will try that on this, too! Once that is sorted out, all I have to do is get it to loop through the directory and rename everything it finds!!!

 

[jadams0173]

Glad it helped. Take a look at the code in red below. It shows how to copy the file and rename it using the File System Object. (make a reference to Microsoft Scripting Runtime)

The blue line a of code does the exact same thing.

Since you need to loop thru the folder and rename each file I would probably use the FSO. If you need more help post back!

Function testthis()
Dim a As String
Dim newname As String
[red]Dim fso As FileSystemObject

Set fso = CreateObject("Scripting.filesystemobject")

[/red]

a = "prtx010.prtx010.0539.123456.815.19222820"
newname = Mid(a, 22, Len(a) - 34) & ".txt"
Debug.Print newname

[red]
fso.CopyFile "C:\" & a, "C:\" & newname
[/red]

[blue]
'FileCopy "C:\" & a, "C:\" & newname
[/blue]

[red]Set fso = Nothing[/red]

End Function

I tried to have patience but it took to long! -DW

 

[proximity]

Hello again,

Thank you very much for your help - the code works a treat. I tried the fso before but neglected to reference it! No wonder it wouldn't work!Doh!

Ok, now the next step. How do I get it to look at anything in the R drive that has this type of filename prtx010.prtx010.0539.123456.815.19222820, pick out the 6 digits we can already do and rename them all in one go??

 

[abaldwin]

Assuming all the files are in the root of the R: drive then look at the DIR function and a simple loop to utilize the code jadams provided.

Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[jadams0173]

The DIR function as abaldwin suggests would do the trick. Are all of the files in the root of the R: drive??

You could also use the FSO.

I tried to have patience but it took to long! -DW

 

[proximity]

Hi everyone,

Yes, all the files are in the R drive.

What I am having trouble with (never mind the loop!) is finding a way of identifying all files in the directory with 40 characters and no file extension. So instead of:
a = "prtx010.prtx010.0539.123456.815.19222820" (which ties me down to that file only), I need a = Whatever is 40 charactes and no extension!

Once that is done, the loop should be fairly easy (I hope).

Any ideas grasped with desperation and appreciation!

--
Steven

 

[abaldwin]

Something like

Dim strFilename as string


strfilename = Dir("r:\*")
do while strfilename <> ""

if len(strfilename) >=40 and snumeric(right(strfilename,3) then
Here is your processing
end if
strfilename = dir("r:\*)
loop


Technically speaking these files have extentions. As a matter of fact they have multiple extentsion. The snippet above checks for the overal length of the file name and insures the last three characters are not purely a string (such as txt, bat, doc, xls, etc) Only way I can think of checking for your specified criteria.


Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[abaldwin]

Oh sorry. this line
if len(strfilename) >=40 and snumeric(right(strfilename,3)

should be

if len(strfilename >= 40 and Isnumeric(right(strfilename,3))

Just typing code in here not testing in an IDE.


Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[proximity]

Hi Andy,

Does something like this seem about right, logically, anyway!!

Function test5()
Dim a As String
Dim newname As String
Dim fso As FileSystemObject
Dim strFilename As String

Set fso = CreateObject("Scripting.filesystemobject")
Do While strFilename <> ""

If Len(strFilename >= 40 And IsNumeric(Right(strFilename, 3))) Then
a = strFilename
newname = Mid(a, 22, Len(a) - 34) & ".txt"

fso.CopyFile "R:\" & a, "R:\" & newname
Set fso = Nothing
End If
strFilename = Dir("R:\*")
Loop
End Function

 

[jadams0173]

Yes that looks correct. I tested this from my C:\ drive using 5 files with your namimg conventions and got the desired results.

Also using the DIR function you could substitue the line in blue(in my first reply) for the FSO.CopyFile line in the loop and do away with the FSO.

Function testthis()
Dim a As String
Dim newname As String
Dim fso As FileSystemObject
Dim FindFile        As String

a = Dir("C:\*")

Set fso = CreateObject("Scripting.filesystemobject")


'a = "prtx010.prtx010.0539.123456.815.19222820"

Do While a <> ""
    If Len(a) >= 40 And IsNumeric(Mid(a, Len(a) - 2)) Then

newname = Mid(a, 22, Len(a) - 34) & ".txt"
Debug.Print newname


fso.CopyFile "C:\" & a, "C:\" & newname
    End If
a = Dir
Loop

'FileCopy "C:\" & a, "C:\" & newname

Set fso = Nothing

End Function

I tried to have patience but it took to long! -DW

 

[abaldwin]

Almost,

1. Before the loop you will need to fill strFilename using
strFilename = Dir("R:\*") to get it to enter the loop the first time.

2. You do not really need the variable "a" as you can simply replace your references to it with strFilename.

3. Move the set fso=Nothing to outside the loop or your subsequent file copies will fail with an error.

Logically it appears to do what you are asking.

Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[jadams0173]

Proximity,

Taking a close look at your code you posted. You need to move the fso=nothing outside the loop. It will error out if you don't or it should since your CreatObject is on the outside of the loop. Create it one time, use it, then destroy it.

   fso.CopyFile "R:\" & a, "R:\" & newname
    [red]Set fso = Nothing[/red]
    End If
strFilename = Dir("R:\*")
Loop

to

    fso.CopyFile "R:\" & a, "R:\" & newname
    
    End If
strFilename = Dir("R:\*")
Loop
[red]Set fso = Nothing[/red]
exit function

I tried to have patience but it took to long! -DW

 

[jadams0173]

Ah, the experienced eyes of abaldwin found more things to fix! Sorry about the double post abaldwin on the ONE error I found .

Have pinkie on me!

I tried to have patience but it took to long! -DW

 

[abaldwin]

No problem. I love this site for the team work between a couple of individuals probably 1,000 miles apart that know nothing of each other being able to help out the OP who is probably 1,000 mile from both of us. GO TEAM Horrraaah LOL


Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[jadams0173]

This site is great ain't it!! I've gotten tons of help and ideas here. I'm FINALLY learning enough and getting confident enough to try to contribute back and help some folks who are where I once was. Dazed, confused and doing a lot of this and this !

I tried to have patience but it took to long! -DW

 

[proximity]

Hi everyone,

What can I say? Everything works flawlessly and a huge thanks to all who have helped me with this - stars all round!

--
Steven

 

[abaldwin]

Your welcome.



Have a sign that says:


I will work for stars!

Andy Baldwin

"Testing is the most overlooked programming language on the books!"

Ask a great question, get a great answer. Ask a vague question, get a vague answer.
Find out how to get great answers FAQ219-2884.

 

[jadams0173]

Glad you got it working!!

I tried to have patience but it took to long! -DW