Help with VBA Code NOT writing to Text File correctly

[purceld2]

Hi there,

The code below is 90% working. The issue I am having is that the code move the 8 test files into the specified folder as expected. But does not write the file detail to the audit file as expected.

It appears that the code is overwriting line 1 and not append the data I have tried & vbNewLine and [FONT=SFMono-Regular, Menlo, Monaco, Consolas, Liberation Mono, Courier New, monospace]& vbCrLf but i get the same results.[/FONT]

[FONT=SFMono-Regular, Menlo, Monaco, Consolas, Liberation Mono, Courier New, monospace]I would expect to see 8 lines for each file that has been moved.[/FONT]

[FONT=SFMono-Regular, Menlo, Monaco, Consolas, Liberation Mono, Courier New, monospace]Any help will be greatly appreciated.[/FONT]

Sub Copy_Move_Files()
   Dim fso As Object
   Dim Cl As Range
   Dim Fldr As String
   
   Set fso = CreateObject("scripting.filesystemobject")
   With Application.FileDialog(4)
      .AllowMultiSelect = False
      If .Show = -1 Then Fldr = .SelectedItems(1)
   End With
   
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      If fso.FileExists(Cl.Value) Then
      fso.CopyFile Cl.Value, Fldr & "\"
      Call Write_file(Cl.Value, Fldr & "\")
      End If
   Next Cl
End Sub


Sub Write_file(CellValue As String, FolderPath As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile("C:\Users\desmo\Desktop\Audit Trail.txt", True, True)
    Fileout.Write CellValue & ", " & FolderPath
    
End Sub

 

[Leith Ross]

Hello purceld2,

The main issue I see is in this line...

    Set Fileout = fso.CreateTextFile("C:\Users\desmo\Desktop\Audit Trail.txt", True, True)

You call this line repeatedly. The call only needs to be once to create the file. Each time it is called you are overwriting any previous information. The use of TRUE without the named argument makes it difficult to read and understand what is happening. Here is what is should look like...

    Set Fileout = fso.CreateTextFile(Filename:="C:\Users\desmo\Desktop\Audit Trail.txt", OverWrite:=True, Unicode:=True)

Here is a more concise version of your macro...

Sub Copy_Move_Files()


    Dim Cl      As Range
    Dim Fileout As Object
    Dim Fldr    As String
    Dim FSO     As Object
    
        Set FSO = CreateObject("Scripting.FileSystemObject")
   
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            If .Show = -1 Then Fldr = .SelectedItems(1) Else Exit Sub
        End With
   
        For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
            If FSO.FileExists(Cl.Value) Then
                FSO.CopyFile Source:=Cl.Value, Destination:=Fldr & "\"
                Fileout.Write Cl.Value & "," & FolderPath & vbCrLf
            End If
        Next Cl
        
End Sub

 

[purceld2]

Hi Leith

Thanks you for your reply very much appreciated. Please forgive me but i am just learning VBA.

I am a bit confused. Your more concise version no longer calls

Sub Write_file(CellValue As String, FolderPath As String)

Is this correct?

I understand what you have explained about the line of code below, but fail to understand where to relocate the line of code where it is only called once.

Set Fileout = fso.CreateTextFile("C:\Users\desmo\Desktop\Audit Trail.txt", True, True)

Very sorry if it is obvious, but I am still learning

Thanks again for your help

Regards

Des