Access 2013 - Procedural folder creation during a CSV import

[TerraFirma]

I am the Admin for my companies Access database. We had a developer build an import process for us using a CSV file. Among other things it procedurally creates folders for each individual client based on their name and unique customer number as part of the import process.

I now want to update this process to create 5 named folders (same names in every folder) within each individual clients folder.

If anyone could help would be great!

Code Below:


ub CreateNewClientFolders()


Dim db As DAO.Database
Dim mySQL As String
Dim rstFolderNames As DAO.Recordset
Dim strInviteCustomField1 As String, strappID As String, strFirstName As String, strLastName As String
Dim strFullDirPath As String


Set db = CurrentDb

strInviteCustomField1 = DLookup("fldExcelCustomFieldName", "tblSurveyGizmoFieldMap", "fldSGQUestion=" & Chr(34) & "Invite Custom Field 1" & Chr(34))
strappID = DLookup("fldExcelCustomFieldName", "tblSurveyGizmoFieldMap", "fldSGQUestion=" & Chr(34) & "appid" & Chr(34))
strFirstName = DLookup("fldExcelCustomFieldName", "tblSurveyGizmoFieldMap", "fldSGQUestion=" & Chr(34) & "First Name" & Chr(34))
strLastName = DLookup("fldExcelCustomFieldName", "tblSurveyGizmoFieldMap", "fldSGQUestion=" & Chr(34) & "Last Name" & Chr(34))

' mysql = "SELECT " & Chr(34) & "_" & Chr(34) & " & [qryImport1]![" & strFirstName & "] & " & Chr(34) & " " & Chr(34) & " & [qryImport1]![" & strLastName & "] & " & Chr(34) & " " & Chr(34) & " & IIf(Len([qryImport1]![" & strInviteCustomField1 & "])>0,[qryImport1]![" & strInviteCustomField1 & "],[qryImport1]![" & strappID & "]) AS FolderName FROM qryImport1;"
mySQL = "SELECT [qryImport1]![" & strFirstName & "] & " & Chr(34) & " " & Chr(34) & " & [qryImport1]![" & strLastName & "] & " & Chr(34) & " " & Chr(34) & " & IIf(Len([qryImport1]![" & strInviteCustomField1 & "])>0,[qryImport1]![" & strInviteCustomField1 & "],[qryImport1]![" & strappID & "]) AS FolderName FROM qryImport1;"

Set rstFolderNames = db.OpenRecordset(mySQL)

If rstFolderNames.RecordCount = 0 Then

MsgBox "No new folders to make"
Set rstFolderNames = Nothing
Set db = Nothing
Exit Sub

Else


rstFolderNames.MoveLast
rstFolderNames.MoveFirst

Do While Not rstFolderNames.EOF

strFullDirPath = DLookup("fldValue", "tblAdmin", "fldIndicator=" & Chr(34) & "ApplicantFilesFolderPath" & Chr(34)) & "\" & rstFolderNames.Fields("FolderName")

If Len(Dir(strFullDirPath, vbDirectory)) = 0 Then
On Error Resume Next
MkDir strFullDirPath
On Error GoTo 0

Else

Debug.Print strFullDirPath & " already exists."

End If

rstFolderNames.MoveNext
Loop


End If


End Sub

[jonh]

MkDir strFullDirPath