using mkdir and filecopy 1

[pandapark]

I've got a directory say \\zurich\images which contains 500 or so images
I've also got an Access 97 Database which has a table containing all the image filenames and another column giving a year.
what i'd like is to loop through that table and say for example the first filename is image1 and the year is 1914 check if the directory \\zurich\images\1914 exists - if it doesn't create the directory and copy the file from \\zurich\images into that new directory OR if the directory does exist then simply copy the file across

any code would be greatly appreciated
thanks
sam

 

[Parax]

using filesystem object

Sub SetFolder(strFolder as string)
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject&quot
If Not fs.FolderExists(strFolder) Then
fs.CreateFolder (Strfolder) ' note needs correct path
end if
end Sub

Note: can Also use FileExits to see if the file exists

to loop through code just use normal recordset process

Sub LoopThrough()
dim rs as recordset
set rs = currentdb.openrecordset("YourTable/Query&quot
with RS
do until .eof
setFolder(![YourFolderField])
.movenext
loop
end with
set rs = nothing
end sub



Mike

 

[Parax]

Oh Forgot Filecopy

fs.copyfile strFrom ,strTo



Whole Process:

Assuming

containg [Folder] and [File] names as strings



Sub MoveImages()
dim rs as recordset
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject&quot
set rs = currentdb.openrecordset("

&quot

with RS
do until .eof
If Not fs.FolderExists("\\zurich\images\" & ![Folder]) Then
fs.CreateFolder ("\\zurich\images\" & ![Folder])
end if
fs.filecopy "\\zurich\images\"& ![File] , "\\zurich\images\" & ![Folder] & "\" & ![File]
.movenext
loop
end with
set rs = nothing
end sub

 

[pandapark]

Mike

thats fantastic - I'll have a play and see how I get on

 

[pandapark]

Mike

This is the code I'm now using which would work brilliantly except for one thing. If say the actual image name is CHE1-030X-NEXX-05-NC004008-TGG.tif then in the DB the image name is only 030X-NEXX-05-NC004008-T so it doesn't find the exact file-name - the DB is from an external source and not all of the images are tif, some are rrd and some are aux files. is there anything i can do here?
thanks
sam

Dim db As Database
Dim rs As Recordset
Dim str As String
Dim fs As Object
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject&quot
str = "SELECT * from County"
Set rs = db.OpenRecordset(str)

With rs
Do Until rs.EOF
MsgBox rs("Content_Control_Date&quot
If Not fs.FolderExists("\\zurich\applications\images\" & rs("Content_Control_Date&quot) Then
fs.CreateFolder ("\\zurich\applications\images\" & rs("Content_Control_Date&quot)
End If
If fs.FileExists("\\zurich\applications\images\" & rs("Image Name&quot) Then
FileCopy "\\zurich\applications\images\" & rs("Image Name&quot, "\\zurich\applications\images\" & rs("Content_Control_Date&quot & "\" & rs("Image Name&quot
Else
MsgBox "No file"
End If
.MoveNext
Loop
End With
Set rs = Nothing

 

[Parax]

if you know all the possible extensions put them into an array and loop round checking if each extension exists

Alternatively try using a wildcard: fs.filecopy "\\zurich\applications\images\" & ![imagename] & "*", , "\\zurich\applications\images\" & ![Content_Control_Date] & "\"

I think that if you only specify a path as the destination it leaves the filename as is.



PS if you use 'with RS' then you can use '.eof' instead of 'rs.eof' and also '![imagename]' instead of 'rs("imagename&quot' - if you want to continue using 'rs("x&quot' then you could remove the 'with rs' and 'end with' statements as long as you change '.movenext' to 'rs.movenext'

you can also just specify the table "County" instead of "SELECT * FROM County" this does not generate a query. eg 'Set rs = currentdb.OpenRecordset("County&quot'

 

[pandapark]

thanks
it doesn't like the use of wildcards - could I use the dir function? to somehow retrieve the name of the file in the folder then see if it the first 28 characters exist in the Image Name within the Database?
I haven't got a clue how i'd code that - as you can tell I'm abit of a beginner at all this

sam

 

[Parax]

Wildcards work with the FS.COPYFILE()

BUT NOT with FILECOPY()


soz I typed it the wrong way round doh!
dodgy memory an all that.

Mike

 

[Parax]

FYI details of the Filesystem Object can be found here:

http://www.sloppycode.net/fso/

=)

 

[pandapark]

thats great thanks - I've just got one problem left now - I try to use if fs.fileexists? - but that doesn't like the use of wildcards so it never finds the file!!!

Dim db As Database
Dim rs As Recordset
Dim str, strfrom, strto As String
Dim fs As Object
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject&quot
str = "SELECT * from County"
Set rs = db.OpenRecordset(str)

With rs
Do Until rs.EOF
strfrom = "\\zurich\applications\images\" & rs("Image Name&quot & "*.tif"
strto = "\\zurich\applications\images\" & rs("Content_Control_Date&quot & "\"
If Not fs.FolderExists("\\zurich\applications\images\" & rs("Content_Control_Date&quot) Then
fs.CreateFolder ("\\zurich\applications\images\" & rs("Content_Control_Date&quot)
End If
If fs.FileExists("\\zurich\applications\images\" & rs("Image Name&quot & "*.tif&quot Then
fs.CopyFile strfrom, strto, True
Else
End If
.MoveNext
Loop
End With
Set rs = Nothing

 

[Parax]

well dont check for the file - if its there it would be moved if it isn't it wont. the fs.copyfile does not error if the file does not exist.



Dim rs As Recordset
Dim fs As Object
const strPath as string = "\\zurich\applications\images\"
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set rs = currentdb.OpenRecordset("County&quot

Do Until rs.EOF
If Not fs.FolderExists(strpath & rs("Content_Control_Date&quot) Then
fs.CreateFolder (strPath & rs("Content_Control_Date&quot)
End If
fs.CopyFile strPath & rs("Image Name&quot & "*", strpath & rs("Content_Control_Date&quot & "\", True
rs.MoveNext
Loop
Set rs = Nothing

 

[pandapark]

I'm getting runtime error 53 ' file not found'? erroring at the fs.copyfile line

Sam

 

[Parax]

oops lol I have on error resume next at the start of the function, this just tells it to skip the error and move on, your right the function does produce an error if it cant find any file, or incorrect path.


Sub moveimages()
on error resume next

Dim rs As Recordset
Dim fs As Object
const strPath as string = "\\zurich\applications\images\"
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set rs = currentdb.OpenRecordset("County&quot

Do Until rs.EOF
If Not fs.FolderExists(strpath & rs("Content_Control_Date&quot) Then
fs.CreateFolder (strPath & rs("Content_Control_Date&quot)
End If
fs.CopyFile strPath & rs("Image Name&quot & "*", strpath & rs("Content_Control_Date&quot & "\", True
rs.MoveNext
Loop
Set rs = Nothing

end sub

 

[pandapark]

that works a treat - thanks for all your time helping me - much appreciated

Sam