Solved Folder Creation

[Cliff67]

Hi All

So not really related to Access but I thought It would be quicker to do this programmatically then by long hand

So what I'm doing is kind or related to a Database. We have board that we test and results are recorded in excel spreadsheets like shown in the Excel results image.

What I need to do now is basically for every result make a folder based on the name of the spread sheet so S-M0471_007.xlsx is now a folder called S-M0470_007

see the Folder Names image.

If I start from a form with windows dialog boxes that that select the file location to change and another one that selects the desired location,

has anyone got any idea how to do this? The excel sheets will be moved across into the folders once created

Thanks in advance

Cliff

 

[theDBguy]

Have you looked into the MKDIR statement?

 

[Cliff67]

Hi BDG

no I haven't. I just wonder how to parse the names of the files to create the folders

 

[theDBguy]

Hi BDG

no I haven't. I just wonder how to parse the names of the files to create the folders

Try using the Dir() function.

 

[bastanu]

Also you might want to read about the FSO object (https://docs.microsoft.com/en-us/of...e/user-interface-help/filesystemobject-object). Are there any subfolders in the original spreadsheet repository? If yes you would need to loop recursively, get the spreadsheet name, create the new folder (sFolderName=Replace(FSOFile.Name,"xlsx","")), move the spreadsheet into it and move next.

Recursion And The FileSystemObject

Cheers,

 

[Pat Hartman]

You can use InStrR() to find the last instance of a character

NameLen = InstrR(Me.SomeFileName, ".") - 1
NewDirName = Left(Me.SomeFileName, NameLen)

 

[moke123]

FileSystemObject has a few methods that would make this easy.

you could try something along the lines of

Sub YourSubName(SourceFile As String, DestinationFolder As String)
'DestinationFolder is the parent folder to put folder being created

    Dim fso As New FileSystemObject

    Dim FolderName As String
    Dim DestinationFile As String

    FolderName = Replace(fso.GetFileName(SourceFile), "." & fso.GetExtensionName(SourceFile), "") ' remove extension from filename

    DestinationFolder = DestinationFolder & "\" & FolderName   'construct full path of new folder
    DestinationFile = DestinationFolder & "\" & fso.GetFileName(SourceFile) 'construct full path of file in new folder

    If fso.FolderExists(DestinationFolder) = False Then
        fso.CreateFolder DestinationFolder          'create the new folder
    End If

    fso.CopyFile SourceFile, DestinationFile      'copy file to new folder
    'fso.MoveFile SourceFile, DestinationFile     'move file to new folder

End Sub

edit: Dont forget to set a reference to Microsoft Scripting Runtime

 

[Cliff67]

Also you might want to read about the FSO object (https://docs.microsoft.com/en-us/of...e/user-interface-help/filesystemobject-object). Are there any subfolders in the original spreadsheet repository? If yes you would need to loop recursively, get the spreadsheet name, create the new folder (sFolderName=Replace(FSOFile.Name,"xlsx","")), move the spreadsheet into it and move next.

Recursion And The FileSystemObject

Cheers,

there are no subfolders. It is structure as Name of PCB, then the serial number of the PCB that has been tested

 

[Cliff67]

FileSystemObject has a few methods that would make this easy.

you could try something along the lines of

Sub YourSubName(SourceFile As String, DestinationFolder As String)
'DestinationFolder is the parent folder to put folder being created

    Dim fso As New FileSystemObject

    Dim FolderName As String
    Dim DestinationFile As String

    FolderName = Replace(fso.GetFileName(SourceFile), "." & fso.GetExtensionName(SourceFile), "") ' remove extension from filename

    DestinationFolder = DestinationFolder & "\" & FolderName   'construct full path of new folder
    DestinationFile = DestinationFolder & "\" & fso.GetFileName(SourceFile) 'construct full path of file in new folder

    If fso.FolderExists(DestinationFolder) = False Then
        fso.CreateFolder DestinationFolder          'create the new folder
    End If

    fso.CopyFile SourceFile, DestinationFile      'copy file to new folder
    'fso.MoveFile SourceFile, DestinationFile     'move file to new folder

End Sub

edit: Dont forget to set a reference to Microsoft Scripting Runtime

Hi Moke, how would I cycle through the source files? there are multiple excel spreadsheets in the folder.

I thought I could use the common dialog box to select the folder name and pass it through, but Access 13 does not support the dialog box anymore.

I've found by stepping through my old code for this Access goes out to lunch so I'm looking at ways to populate a text box for the selection

Cliff

Update - I've got the text box working

 

[arnelgp]

see this sample.

 

[Cliff67]

see this sample

arnelgp you absolute hero, that works like a dream, that has saved me days and days of work, I can't thank you enough

 

[Cliff67]

arnelgp you absolute hero, that works like a dream, that has saved me days and days of work, I can't thank you enough

Update to this, I opened up the source folder and found some early .doc test results,

do I add
cn.Add Replace$(s, ".doc", "")
to the code?

many thanks

Cliff

 

[arnelgp]

so it is not .xlsx, but "all" the files on that folder?
i made changes for you to test.

 

[Cliff67]

so it is not .xlsx, but "all" the files on that folder?
i made changes for you to test.

That works a treat, testing it through and I've almost finished the first product range. Many many thank

 

[arnelgp]

you're welcome.

 

[Cliff67]

slight problem, It creates all the folders but then copies all the files to the target folder only

 

[moke123]

Opps. I'm late to the game.

I threw this together so might as well upload it.

BTW, if you didn't notice , in my version you can either move or copy the file to the new folder. Just comment/uncomment the line.
Its currently set to just copy them.
It also is not file type specific. It will move or copy any files in the source folder.

 

[arnelgp]

sorry about that, i must have deleted most of the code.
here test it again.

 

[Cliff67]

sorry about that, i must have deleted most of the code.
here test it again.

that's Ok I do my testing with local copies of the spreadsheets from our repository, if it messes up I delete and re-download them again

 

[Cliff67]

that seems to have done the trick, many thanks it is much appreciated