Excel VBA: Create txt files in a specific file

Hello experts,

I have the following procedure which allows me to create txt file :


Sub Create_Files()
'ActiveSheet should be refer as following:
'Column A: File Name
'Column B: Extention file
'Column C content


Dim i As Long
Dim fileName As String
Dim folder As String
Dim fNum As Long
Dim lr As Long
Dim ws As Worksheet
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

    ' Promt
        strPrompt = "Make sure that you have reported the following Reference activesheet as following:" _
        & "Column A: file Name" _
        & "Column B: Extention file" & vbCr & "OK?"

    ' Dialog's Title
    strTitle = "Title"

    'Display MessageBox
    iRet = MsgBox(strPrompt, vbQuestion + vbYesNo, strTitle)

    ' Check pressed button
    If iRet = vbNo Then
        MsgBox "The code will exit now.", vbExclamation, "Action Cancelled By You!"
        Exit Sub
    End If


lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
folder = ""
'Change to folderpicker
'With Application.FileDialog(msoFileDialogFolderPicker)
'.Title = sTitle
'.ButtonName = sButton
'.InitialFileName = sStartFrom

'If .Show = -1 Then    ' if OK is pressed
'sFolder = .SelectedItems(1)
'End If
'End With

'If sFolder <> "" Then    ' if a file was chosen

'MsgBox sFolder


Set ws = ActiveSheet
If Len(Dir(folder & Format(Now, "yyyy_mm_dd_hh") & "\", vbDirectory)) = 0 Then
MkDir folder & Format(Now, "yyyy_mm_dd_hh") & "\"
End If

folder2 = folder & Format(Now, "yyyy_mm_dd_hh") & "\" 'REMEMBER END BACKSLASH


For i = 2 To lr
fileName = folder2 & ws.Cells(i, "A").Value & ws.Cells(i, "B").Value
fNum = FreeFile
Open fileName For Output As #fNum
Print #fNum, ws.Cells(i, "C").Value
Close #fNum
Next

MsgBox "Files have been created at " & folder2

End Sub

Open in new window


I would like to review it  as following:
1-Display folderpicker (initial folder C:\) to select the folder in which txt file should be created
2-Create the txt file with the following name “Script”
3-It should contain the following:
“Sub
-
-
-
-
-
-
-
-
-
-
-
-
End sub”

If you have questions, please contact me.
Thank you in advance for your help.
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Eh, why have you commented out lines 39-47?

As far as I can see that code is meant for picking a folder.
LD16Author Commented:
Hello,
No, I add picking foder as comment because the procedure is meant to work with a reported folder and not with picking.

I simplified the procedure as following:

Sub Create_File_2()
Dim fso As Object
Dim sContent As String
Set fso = CreateObject("Scripting.FileSystemObject")
Dim xPath As String
Dim Fileout As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
    End With
    On Error Resume Next
    sContent = "Sub End Sub"
    xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    Set Fileout = fso.CreateTextFile(xPath & "\script.txt", True, True)
    Fileout.Write sContent
    Fileout.Close
    MsgBox ("File has been created at " & xPath)
End Sub

Open in new window


Could you please help me to:
1-Set a content with lines breaks so I can report for each line an specific content:
scontent = "line 1 content"
scontent =  scontent & "line 2 content"
2-Msgbox ("No file created") if cancel button is selected from folder picker and exit sub.

Thank you very much for your help.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Maybe this?

Sub Create_File_2()
Dim fso As Object
Dim sContent As String
Set fso = CreateObject("Scripting.FileSystemObject")
Dim xPath As String
Dim Fileout As Object
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder"
        If .Show = -1 Then
            xPath = .SelectedItems(1)
        Else
            MsgBox "You didn't select any folder.", vbExclamation, "Action Cancelled!"
            Exit Sub
        End If
    End With
    sContent = "Sub" & vbNewLine 'End Sub"
    sContent = sContent & "Line2" & vbNewLine
    sContent = sContent & "Line3" & vbNewLine
    sContent = sContent & "End Sub"
    xPath = xPath & "\"
    Set Fileout = fso.CreateTextFile(xPath & "\script.txt", True, True)
    Fileout.Write sContent
    Fileout.Close
    MsgBox ("File has been created at " & xPath)
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

LD16Author Commented:
Tested and it works. I just realized that It can be useful to finish the procedure by opening windows explorer in which has been generated the file. What is your advice for this? Use shell or there is already a vba procedure to open windows explorer?
Thank you in advance for your help.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You can insert the following line after line#24
Shell "C:\WINDOWS\explorer.exe """ & xPath & "", vbNormalFocus

Open in new window

This will open the folder where the text file was created.
LD16Author Commented:
Tested and it works.
Thank you very much for your help!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome! Glad it worked as desired.
Thanks for the feedback.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.