Getting error while creating a text file

Question

Hi,
I have one macro which will write all the file names from a particular folder into a text file. However when I run it, I am getting the following error message and only last file of the identified folder is getting added in my text file.
Run Time Error '55'
File Already Open
To reproduce the scenario please add one commandbutton in your excel shhet and add the following code:
Private Sub CommandButton1_Click()
Dim p As String, x As Variant
p = "C:/*.docx"
x = GetFileList(p)
Select Case IsArray(x)
Case True 'files found
MsgBox UBound(x)
For i = LBound(x) To UBound(x)
Open "C:\temp.txt" For Output As 1
Write #1, "File Name " & x(i)
Next i
Close #1
Case False
MsgBox "No matching files"
End Select
End Sub
Function GetFileList(FileSpec As String) As Variant
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
'End Function
For example if I have 3 docx file(1,2,3-name of the files) in my C drive, the o/p that I want in my .txt file will be as follows.
File Name 1.docx
File Name 2.docx
File Name 3.docx
Thanks!!

Answer 1

For i = LBound(x) To UBound(x)
Open "C:\temp.txt" For Output As 1
You call the Open method inside the FOR loop.
BTW, a collection is much more easier.
Andreas.
Private Sub CommandButton1_Click()
Dim Files As New Collection
Dim File
Dim ff As Integer
File = Dir("C:\*.docx")
Do While File <> ""
Files.Add File
File = Dir
Loop
If Files.Count = 0 Then
MsgBox "No matching files"
Exit Sub
Else
MsgBox Files.Count & " files"
End If
ff = FreeFile
Open "C:\temp.txt" For Output As #ff
For Each File In Files
Print #ff, File
Next
Close #ff
End Sub