VBA Run time Error "424

[purceld2]

I am having a problem with the VBA code below it works fine with

Fileout.Write "This is a test"

but files when

Fileout.Write Cl.Value, Fldr & ""

Also it seems to be overwriting the same line so I think a new line command somewhere. Also os it posible to get the code to append to the list rather than overwrite.

Your help will be greatly appreciated

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
      End If
   Next Cl
End Sub


Sub Write_file()
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 Cl.Value, Fldr & "\"
    Fileout.Close
End Sub

Regards
Des

 

[Kenneth Hobson]

I have not tested but maybe:

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
   
   Set Fileout = fso.CreateTextFile("C:\Users\desmo\Desktop\Audit Trail.txt", True, True)
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      If fso.FileExists(Cl.Value) Then
        fso.CopyFile Cl.Value, Fldr & "\"
        Fileout.Write Cl.Value, Fldr & "\"
      End If
   Next Cl
   Fileout.Close
End Sub

 

[purceld2]

Hi Kenneth,

I am getting the following error message

<a href="https://ibb.co/0tdBTSs"><img src="https://i.ibb.co/Kw3NdkK/Capture-2.jpg" alt="Capture-2" border="0"></a>
<a href="https://imgbb.com/"><img src="https://i.ibb.co/m0MpJgh/Capture-1.jpg" alt="Capture-1" border="0"></a>

 

[RoryA]

You should pass Cl.Value and Fldr as arguments to the called sub:

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
    Fileout.Close
End Sub

 

[purceld2]

Hi Rory,

Please excuse me if I have missed something obvious but still getting an error message see below

<a href="https://ibb.co/qm8bGwG"><img src="https://i.ibb.co/L9y4wfw/Capture-2.jpg" alt="Capture-2" border="0"></a>
<a href="https://imgbb.com/"><img src="https://i.ibb.co/LrXGGKS/Capture-1.jpg" alt="Capture-1" border="0"></a>

 

[RoryA]

Sorry, didn't look at your original code closely enough. Write only takes one argument, so I assume you intend to write those two values with a comma betweeen them? If so, it should be:

Fileout.Write CellValue & ", " & FolderPath

 

[purceld2]

Hi Rory,

Thanks for all your time. the code is coping the files fine but the audit seems to be overwriting the first line in the file.

Is there some way for each file copied it puts it on a new line in the audit file and if it's not too much trouble always appends new data to the file.

Once again thanks for all your help.

 

[RoryA]

Your current code overwrites the text file each time. You could do something like this:

Sub Write_file(CellValue as string, FolderPath as string)
Const ForAppending as long = 8
Dim LogFileName as string
LogFileName = "C:\Users\desmo\Desktop\Audit Trail.txt"
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

 Dim Fileout As Object
   Set Fileout = fso.OpenTextFile(logfilename, forappending, True) ' the True allows it to be created if it doesn't already exist

    Fileout.WriteLine CellValue & ", " & FolderPath
    Fileout.Close
End Sub

 

[purceld2]

Hi Rory

I have run the amended code and it has moved the expected files successfully to the target folder but when I checked the Audit files it appears to be writing to the file but apparently in a different language (see below)

Any advice

㩃䑜獥潭摮䴠獵捩䵜獵捩䰠扩慲祲㈠㄰尸〰䐠捥㈠㄰‸敓敬瑣摥吠湵獥ぜ‴*⁁畃⁰晏吠慥洮㍰‬㩃啜敳獲摜獥潭䑜獥瑫灯乜睥䐠湥楮⁳牂睯屮਍㩃䑜獥潭摮䴠獵捩䵜獵捩䰠扩慲祲㈠㄰尸〰䐠捥㈠㄰‸敓敬瑣摥吠湵獥ぜ‹*汏⁥慍楒敶⹲灭ⰳ䌠尺獕牥屳敤浳屯敄歳潴屰敎⁷敄湮獩䈠潲湷൜䌊尺敄浳湯⁤畍楳屣畍楳⁣楌牢牡⁹〲㠱ぜ‰楋杮摳污⁥佈⁔慂正灵䑜湥楮⁳牂睯*桔敲⁥敍污⁳⁁慄⁹㈱湩档洮㍰‬㩃啜敳獲摜獥潭䑜獥瑫灯乜睥䐠湥楮⁳牂睯屮਍㩃䑜獥潭摮䴠獵捩䵜獵捩䰠扩慲祲㈠㄰尸〰匠汥捥整⁤潴倠慬⁹〲㤱ぜ‰潄湷潬摡摥㈠〵㈴㄰‹敓敬瑣摥吠汐祡䑜湥楮⁳牂睯†敗汬圠瑩潨瑵圠瑡牥ㅛ⹝灭ⰳ䌠尺獕牥屳敤浳屯敄歳潴屰敎⁷敄湮獩䈠潲湷൜䌊尺敄浳湯⁤畍楳屣畍楳⁣楌牢牡⁹〲㠱ぜ‰敓敬瑣摥琠汐祡㈠㄰尹〰䐠睯汮慯敤⁤㔲㐰〲㤱匠汥捥整⁤潔倠慬屹敄湮獩䈠潲湷ⴠ䔠獡⹹灭ⰳ䌠尺獕牥屳敤浳屯敄歳潴屰敎⁷敄湮獩䈠潲湷൜䌊尺敄浳湯⁤畍楳屣畍楳⁣楌牢牡⁹〲㠱ぜ‰敓敬瑣摥琠汐祡㈠㄰尹〰䐠睯汮慯敤⁤㔲㐰〲㤱匠汥捥整⁤潔倠慬屹敄湮獩䈠潲湷ⴠ䔠敶祲潢祤⁳敎摥⁳潌敶洮㍰‬㩃啜敳獲摜獥潭䑜獥瑫灯乜睥䐠湥楮⁳牂睯屮਍㩃䑜獥潭摮䴠獵捩䵜獵捩䰠扩慲祲㈠㄰尸〰匠汥捥整⁤潴倠慬⁹〲㤱ぜ‰潄湷潬摡摥㈠〵㈴㄰‹敓敬瑣摥吠汐祡䑜湥楮⁳牂睯*慒湩䘠潲桔⁥歓敩⹳灭ⰳ䌠尺獕牥屳敤浳屯敄歳潴屰敎⁷敄湮獩䈠潲湷൜䌊尺敄浳湯⁤畍楳屣畍楳⁣楌牢牡⁹〲㠱ぜ‰敓敬瑣摥琠汐祡㈠㄰尹〰䬠湩獧慤敬䈠捡畫⁰畔敮屳㄰ⴠ䐠湥楮⁳牂睯*潃据湥牴瑡潩䔨瑸湥敤⥤洮㍰‬㩃啜敳獲摜獥潭䑜獥瑫灯乜睥䐠湥楮⁳牂睯屮਍

Regards

Desmond

 

[RoryA]

I can't replicate that. I've just tested the code (only changing the file path) and it puts the data in in English, not Chinese!