Create empty .txt files based on a range of cell values

[lecex]

Hi,
I am looking for a way to create a list of empty .txt files based that are based on the values of a range of cells.
Here is what I have but no file is ever created.
Please note that I am a beginner in VBA and tried to adapt some code I found on the web.
Thanks in advance for any advice/suggestions.
Lex.

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Dim filename As String
Set Rng = Selection

maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
'MkDir (ActiveWorkbook.Path & "\" & Rng(r, c)) - THE CODE WORKS FOR CREATING FOLDER NAMES

'BUT WHEN I TRY TO ADAPT THE CODE AND USE THE SAME LOGIC FOR CREATNG FILES NO FILE GETS CREATED
filename = Rng(r, c) & ".txt"
'MsgBox filename I USED THIS TO CHECK IF THE FILENAME IS CORRECT

Open ActiveWorkbook.Path & filename For Output As r
Close r

On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

 

[Domenic]

If you replace...

'MsgBox filename I USED THIS TO CHECK IF THE FILENAME IS CORRECT

with

MsgBox ActiveWorkbook.Path & filename

...does it display the expected path and filename?

 

[lecex]

Thanks for you help - indeed, one character was missing.
My little first program is almost functional. The program (see code below) works for the first 10 lines and then it hangs for a mysterious reason.
Any ideas or suggestions why this might be happening?
I have also copied my mini sheet that I use to test the code where I select the cells between E1 and E14 before running the macro.
Thanks in advance for any suggestions
Cheers

Sub CreateFiles()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Dim filename, FilePath, FileOnly As String
FilePath = ThisWorkbook.FullName
FileOnly = ThisWorkbook.Name
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
filename = Rng(r, c) & ".txt"
Open ThisWorkbook.Path & "\" & filename For Output As r
Close r
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

Minisheet posted below

file creation sample1.xlsx
	A	B	C	D	E
1	EN	1	xl xxxx	Ulxxxxxdexn 3	[1] xl xxxx - Ulxxxxxdexn 3 (EN)
2	EN	2	xlxn xxxydxx	xxexxing Ixxxxx exxxk (x07)	[2] xlxn xxxydxx - xxexxing Ixxxxx exxxk (x07) (EN)
3	EN	3	xlxxxxxx xxxk	xeginningx	[3] xlxxxxxx xxxk - xeginningx (EN)
4	EN	4	xllen xkxwx	xixxxxd'x xlxxnxx xuxxex xx85	[4] xllen xkxwx - xixxxxd'x xlxxnxx xuxxex xx85 (EN)
5	EN	5	xllen Vxng	xill xxxxxx'x xxxxx xxuxx	[5] xllen Vxng - xill xxxxxx'x xxxxx xxuxx (EN)
6	EN	6	xlxx xxxxkxxn	xxexxy xexding xx6	[6] xlxx xxxxkxxn - xxexxy xexding xx6 (EN)
7	EN	7	xngelx xxxxxne	xxe xngelx xxxxxne Lexxuxe Nxxex	[7] xngelx xxxxxne - xxe xngelx xxxxxne Lexxuxe Nxxex (EN)
8	EN	8	xnxxxny xlxxk	xexuxxexxixn Dxexxx	[8] xnxxxny xlxxk - xexuxxexxixn Dxexxx (EN)
9	EN	9	xnxxnxx xxxxxnez	x xxxk	[9] xnxxnxx xxxxxnez - x xxxk (EN)
10	EN	10	xxxxy Gxxxn	xxe Dixe xnd xuxxe xxxklex	[10] xxxxy Gxxxn - xxe Dixe xnd xuxxe xxxklex (EN)
11	FR	11	le xexxx xxgxxxen	Ixxenxxxle xxuxine N°36 - Ixxxxxixle xexxuxnexenx	[11] le xexxx xxgxxxen - Ixxenxxxle xxuxine N°36 - Ixxxxxixle xexxuxnexenx (FR)
12	FR	12	le xexxx xxgxxxen	Ixxenxxxle xxuxine N°37 - xu ex xxn xxîxxe	[12] le xexxx xxgxxxen - Ixxenxxxle xxuxine N°37 - xu ex xxn xxîxxe (FR)
13	FR	13	le xexxx xxgxxxen	Ixxenxxxle xxuxine N°43 - x'exx xxx xini	[13] le xexxx xxgxxxen - Ixxenxxxle xxuxine N°43 - x'exx xxx xini (FR)
14	EN	14	Jexn-xxexxe xxllxxxnx	L'Enxyxlxxédie dex xièxex xxl-3	[14] Jexn-xxexxe xxllxxxnx - L'Enxyxlxxédie dex xièxex xxl-3 (EN)
WL

Cell Formulas
Range	Formula
E1:E14	E1	=CONCATENATE("[",B1,"] ",C1," - ",D1," (",A1,")")

 

[Domenic]

First, remove the statement On Error Resume Next from your code. Then, try running your code again and see whether it uncovers any errors.

 

[lecex]

Thanks - with some additional cleaning up of the filenames (i.e.. removing or replacing characters that are not allowed for filename creation) I was able to run the program successfully for creating a few hundred files in a split second.
Thanks for all your help.
My adventure with VBA continues

 

[lecex]

HI,
I have been able to cleanup and have a working program.
However something awkward is happening.
The program creates only 512 files and not more.
At first I thought there was a typo in the filename (such as having a "?", "/", or any non-accepted character in the filename : but this is not the case. All filenames are correct.
Anyone has any idea why the program stops after having created 512 filenames?
Thanks

 

[Domenic]

It could be a timing issue. Try adding DoEvents after each Close statement. Maybe try pausing the macro for a few seconds after every certain amount of files. You would have to experiment.

So maybe pause the macro for 3 seconds after every 10 files. Maybe something like this. First add the following macro to your project...

Sub PauseMacro(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer + secs
  
    Do
        DoEvents
    Loop Until Timer > endTime
  
End Sub

Then amend your macro as follows...

For c = 1 To maxCols
    r = 1
    Do While r <= maxRows
        If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c).Value, vbDirectory)) = 0 Then
            Filename = Rng(r, c) & ".txt"
            Open ThisWorkbook.Path & "\" & Filename For Output As r
            Close r
            DoEvents
        End If
        If r Mod 10 = 0 Then
            PauseMacro 3 'seconds
        End If
        r = r + 1
    Loop
Next c

Does this help?

 

[lecex]

Hi Dominic,

Thank you for your suggestion and my apologies of my delayed response.

Unfortunately your suggestion does not work. I tried with multiple versions of MOD (mod 2, mod 5, mod 10) and multiple waiting periods 1 - 2 - 10 seconds : all resulting in the same behavior (file creation stops after 512 files)
Then I thought the there could be a funny character in file 513 so I named all the files (from 1 to 1000) the same with the only difference being a number in front of the file such as :
[1] xxxx - xxxx.txt
[2] xxxx - xxxx.txt
[3] xxxx - xxxx.txt, etc. etc.
But whatever I do the program always stops after having created exactly 512 files

When I remove the line "On Error Resume Next" I get the following error message (after having created successfully 512 files) : error 52 - bad file name or number

Any suggestions are welcome

Thanks

 

[Domenic]

I see now that the file number is actually the problem. The range for a valid file number is 1 to 511 inclusive, as per the following article...

Open statement (VBA)

Office VBA reference topic

docs.microsoft.com

Therefore, use the FreeFile function to get the next file number available for use by the Open statement.

 

[lecex]

Works like a charm
Thank you very much for all your help
Have a great day