Automatically copy files into folders

  • Thread starter Thread starter andreashermle
  • Start date Start date
A

andreashermle

Dear experts:

I got 80 single ods-files (created by Excel but then saved as ods-
files). They are all stored in the following directory: C:\Graphics\

The file naming convention of these 80 single ods-files is as
follows:

Martin_Graphics_10.ods
Martin_Graphics_12.ods
Martin_Graphics_16.ods
.....
Martin_Graphics_100.ods

The folder C:\Graphics contains 80 subfolders where all these files
are to be copied into. Their naming is as follows:

Chapter_10_ready (C:\Graphics\Chapter_10_ready)
Chapter_12_ready (C:\Graphics\Chapter_12_ready)
Chapter_16_ready (C:\Graphics\Chapter_16_ready)
....
Chapter_100_ready (C:\Graphics\Chapter_100_ready)

Now here comes my question: Is it possible to copy these files into
their respective folder, using VBA?
The numbers are not incremented by 1 but irregular, but they are
sorted. So are the folders where the files should be stored.

Any professional help would be much appreciated.

Thank you very much in advance. Regards, Andreas
 
To get you going have a look at VBA:
- Microsoft Scripting Runtime library - you'd be interested in
FileSystemObject
- NAME method - it elegantly moves files over.

post back if you get stuck.
 
To get you going have a look at VBA:
- Microsoft Scripting Runtime library - you'd be interested in
FileSystemObject
- NAME method - it elegantly moves files over.

post back if you get stuck.









- Show quoted text -
Click to expand...

Dear AB,

thank you very much for your tip. To be honest with you, I got no idea
how to put your tip into practice.

Regards, Andreas
 
Ok then try playing with this code - it does what you need:
- it doesn't have any error trapping (i.e., your file/folder names
must be consistent)
- doesn't work for files/folders with '100' in it - you just need to
tweak the code to allow for that as currently it would treat the '100'
as '00', i.e., it would drop the '1'.
The code:

Sub MoveODS_Around()
Dim fso As Object
Dim mF As Object
Dim ndx As Long
Dim posExt As Long

Set fso = CreateObject("Scripting.FileSystemObject")

'Next loops through all the files that exist in C:\Graphics
For Each mF In fso.GetFolder("C:\Graphics").Files
'Find the position of the extension in the file name
posExt = InStr(1, mF.Name, ".")
'Find what the Index number in your file is, e.g., if the file
name: _
Martin_Graphics_12.ods _
then its index is '12'.
ndx = Mid(mF.Name, posExt - 2, 2) 'For 100 would return 00
'Moves the file to the folder with the same Index in its name
mF.Move "C:\Graphics\Chapter_" & ndx & "_ready\"
Next

End Sub

Post back if you get stuck.
 
Ok then try playing with this code - it does what you need:
- it doesn't have any error trapping (i.e., your file/folder names
must be consistent)
- doesn't work for files/folders with '100' in it - you just need to
tweak the code to allow for that as currently it would treat the '100'
as '00', i.e., it would drop the '1'.
The code:

Sub MoveODS_Around()
    Dim fso As Object
    Dim mF As Object
    Dim ndx As Long
    Dim posExt As Long

    Set fso = CreateObject("Scripting.FileSystemObject")

    'Next loops through all the files that exist in C:\Graphics
    For Each mF In fso.GetFolder("C:\Graphics").Files
        'Find the position of the extension in the file name
        posExt = InStr(1, mF.Name, ".")
        'Find what the Index number in your file is, e.g., if thefile
name: _
                Martin_Graphics_12.ods _
                then its index is '12'.
        ndx = Mid(mF.Name, posExt - 2, 2) 'For 100 would return00
        'Moves the file to the folder with the same Index in its name
        mF.Move "C:\Graphics\Chapter_" & ndx & "_ready\"
    Next

End Sub

Post back if you get stuck.







- Zitierten Text anzeigen -
Click to expand...

Dear AB:

ok, thank you very much. I will give a try and let you know.

Regards, Andreas
 
Dear AB:

ok, thank you very much. I will give a try and let you know.

Regards, Andreas- Zitierten Text ausblenden -

- Zitierten Text anzeigen -
Click to expand...

Hi AB,

works like a charm.

Thank you very much for your professional help. I really appreciate
it.

Regards, Andreas
 
Back
Top