bilo11
03-11-2011, 03:58 AM
Hi Guys
Please help. I have been trying to create a system that will dynamically create folders for seta of pupils when a button is pressed. I have created a function (code below), but unfortunately it seems to miss out a couple of the pupils from the class.
Public tg As String ' stores the selected teaching group
Public ao As String ' stores the selected assessment objective
Public strFolderName As String ' stores the folder for files to be saved in
Dim i As Integer
Dim ul As Long
' The following code will ask the user to select a destination folder.
' It will then create sub-folders for each pupil and put their powerpoint
' templates inside.
Public Function createFolders()
MsgBox ("Please choose a folder to save the files to.") ' prompt to select folder
strFolderName = BrowseFolder("Choose Folder For Import")
If Len(strFolderName) > 0 Then
Dim fsoObj As Object
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
Sheets("Results").Select
i = 1
ul = 5000
For i = 1 To ul
If ActiveSheet.Cells(i, 3).Value = tg Then
If .FolderExists(strFolderName & "\" & ActiveSheet.Cells(i, 2).Value & "\") Then
Else
.CreateFolder (strFolderName & "\" & ActiveSheet.Cells(i, 2).Value & "\")
End If
i = i + 1
End If
Next
End With
Else
MsgBox ("Please choose a folder to save the files to.")
End If
End Function
Please let me know if you need any more info as I would love to get this minor, but very important, setback resolved.
Ben
Please help. I have been trying to create a system that will dynamically create folders for seta of pupils when a button is pressed. I have created a function (code below), but unfortunately it seems to miss out a couple of the pupils from the class.
Public tg As String ' stores the selected teaching group
Public ao As String ' stores the selected assessment objective
Public strFolderName As String ' stores the folder for files to be saved in
Dim i As Integer
Dim ul As Long
' The following code will ask the user to select a destination folder.
' It will then create sub-folders for each pupil and put their powerpoint
' templates inside.
Public Function createFolders()
MsgBox ("Please choose a folder to save the files to.") ' prompt to select folder
strFolderName = BrowseFolder("Choose Folder For Import")
If Len(strFolderName) > 0 Then
Dim fsoObj As Object
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
Sheets("Results").Select
i = 1
ul = 5000
For i = 1 To ul
If ActiveSheet.Cells(i, 3).Value = tg Then
If .FolderExists(strFolderName & "\" & ActiveSheet.Cells(i, 2).Value & "\") Then
Else
.CreateFolder (strFolderName & "\" & ActiveSheet.Cells(i, 2).Value & "\")
End If
i = i + 1
End If
Next
End With
Else
MsgBox ("Please choose a folder to save the files to.")
End If
End Function
Please let me know if you need any more info as I would love to get this minor, but very important, setback resolved.
Ben