Populating Folders from a form

[themanof83]

HI guys,

I have a form which looks up a lot of data from each individual record in a table. One of the fields is called document folder. I would like to create a button that when clicked creates a folder (name=document folder) in a ceratin location for all records. Therefore populating x amount of empty folders with individual names depending on the number of records.

Thanks in advance.

Regards,

Ashley

 

[DCrake]

Simple Software Solutions

In short Yes.

Here is some code to do that. What you need to do is to create a new module and paste in the following code:

Function FSODateLastModified(AnyFile As String) As String

Dim FSO As New FileSystemObject, FileInfo As File

If Dir(AnyFile) <> "" Then
    Set FileInfo = FSO.GetFile(AnyFile)
    FSODateLastModified = CStr(FileInfo.DateLastModified)
Else
    FSODateLastModified = "Unknown"
End If

    
End Function


Function FSOFindFiles(sFol As String, sFile As String)

Dim tFld As Folder, tFil As File, FileName As String
Dim DLM As String, tPath As String
Dim fld As Folder, fType As String


Dim FSO As New FileSystemObject, FileInfo As File
   
   On Error GoTo Catch
   If FSO.FolderExists(sFol) Then
   Set fld = FSO.GetFolder(sFol)
   FileName = Dir(FSO.BuildPath(fld.Path, sFile), vbNormal Or vbReadOnly)
    
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(FSO.BuildPath(fld.Path, FileName))
      tPath = FSO.BuildPath(fld.Path, FileName)
        Set FileInfo = FSO.GetFile(tPath)
        DLM = CStr(FileInfo.DateLastModified)
        fType = CStr(FileInfo.Type)
        
    If IsLoaded("FrmWzdMainDetails") Then
        If Right(FileName, 3) <> "tmp" Then
            FrmWzdMainDetails.ctList1.AddItem FileName + ";" + DLM + ";" + fType
        End If
    End If
      FileName = Dir()
      DoEvents
   Wend
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

Function FSOFindDocs(sFol As String, sFile As String)

Dim tFld As Folder, tFil As File, FileName As String
Dim DLM As String, tPath As String
Dim fld As Folder, fType As String

Dim FSO As New FileSystemObject, FileInfo As File
   
   On Error GoTo Catch
   Set fld = FSO.GetFolder(sFol)
   FileName = Dir(FSO.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
    
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(FSO.BuildPath(fld.Path, FileName))
      tPath = FSO.BuildPath(fld.Path, FileName)
        Set FileInfo = FSO.GetFile(tPath)
        DLM = CStr(FileInfo.DateLastModified)
        fType = CStr(FileInfo.Type)
        
        
   '     FrmContractDetails.ctList4.AddItem FileName + ";" + DLM + ";" + fType
      FileName = Dir()
      DoEvents
   Wend
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

Function PathExists(sFol As String) As Boolean
   Dim FSO As New FileSystemObject
   PathExists = FSO.FolderExists(sFol)

End Function

Function CreateNewFolder(sFol As String)
   Dim FSO As New FileSystemObject
   FSO.CreateFolder sFol
End Function

Function CopyFiles(sDoc As String, dDoc As String)
   Dim FSO As New FileSystemObject
   FSO.CopyFile sDoc, dDoc, True
   
    
End Function

Save the module as modFSO

Rememer to add Microsoft Scripting Runtime to your references.

Some of the lines of code are pertaining to an existing application and may through out an error or two. Modify accordingly.

Remember to use the PathExists() function prior to the CreateNewFolder() function.


CodeMaster:

 

[themanof83]

Thanks DCrake, looks increadibly awesome, but as a novice I have little idea of wot's going on. Could you give me an idea of where I might be naming my folders please? And how I could incorporate it into an 'on Click' Event.

 

[GaryPanic]

there is a simple make directory function ..

if you want a folder per record

Policyno , 6 is my unique reference (its a unique number in order 50001,50002 etc) and is a field on my form


Private Sub Ctl_cmbMkDir_Click()
On Error GoTo Err_cmbMkDir_Click

Dim DirName As String
Dim Response As String

DirName = "C:\xxxxxxx\" & Left(Me!PolicyNo, 6)


If Dir(DirName, vbDirectory) = "" Then
If MsgBox("OK to create folder!", vbOKCancel) = vbOK Then
MkDir DirName
Else
MsgBox "Create folder cancelled. Folder not created."
Exit Sub
End If
Else
MsgBox "The folder already exists..." & Chr(10) & "Please check the directories using Windows Explorer.", vbOKOnly
Exit Sub
End If

Response = MsgBox(DirName, vbOKOnly)



Exit_cmbMkDir_Click:
Exit Sub

Err_cmbMkDir_Click:
MsgBox Err.Description
Resume Exit_cmbMkDir_Click