Hi,
Gone through many post and find a solution to create Folder Structure as in following Code:
Sub CreateDirs()
    Dim R As Range
    For Each R In Range("A2:A1000")
        If Len(R.Text) > 0 Then
            On Error Resume Next
            Shell ("cmd /c md " & Chr(34) & Range("A1") & "\" & R.Text & Chr(34))
            On Error GoTo 0
        End If
    Next R
End Sub
Sub CreateDirsFullPaths()
    Dim R As Range
    For Each R In Range("A1:A1000")
        If Len(R.Text) > 0 Then
            On Error Resume Next
            Shell ("cmd /c md " & Chr(34) & R.Text & Chr(34))
            On Error GoTo 0
        End If
    Next R
End Sub
I have also found a piece of Code to generate Text Files as follows:

Sub generatTXT()
Const forReading = 1, forAppending = 3, fsoForWriting = 2
Dim fs, objTextStream, sText As String
Dim lLastRow As Long, lRowLoop As Long, lLastCol As Long, lColLoop As Long

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lRowLoop = 1 To lLastRow

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objTextStream = fs.opentextfile("c:\_exout\" & Cells(lRowLoop, 1) & ".txt", fsoForWriting, True)

    sText = ""

    For lColLoop = 1 To 7
        sText = sText & Cells(lRowLoop, lColLoop) & Chr(10) & Chr(10)
    Next lColLoop

    objTextStream.writeline (Left(sText, Len(sText) - 1))


    objTextStream.Close
    Set objTextStream = Nothing
    Set fs = Nothing

Next lRowLoop

End Sub
I wish to join both join to produce text file with contents in in folder created at desired location.
Say Folder Structure in
Col A1 = D:/Folder1/SubFolder1/TextFile.txt
Col A2 = Content to put into TextFile.txt

Or as follows
Col A1 = Folder Name = Folder 1
Col B2 = Sub Folder Folder Name = SubFolder1
Col C3 = Text File Name = TextFile.txt
Col D4 to D6 = Contents to put inside Text File
Data Columns defined above may falls under following shape too, that is not an issue.
A1/B2/C3/D4/D5/D6 may be A1/A2/A3/A4/A5/A6

I know a fresh code may require to achieve this I posted both codes just for reference.