VBA Run time Error "424

purceld2

Well-known Member
Joined
Aug 18, 2005
Messages
586
Office Version
  1. 2013
Platform
  1. Windows
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

Code:
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
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
I have not tested but maybe:
Code:
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
 
Upvote 0
Hi Kenneth,

I am getting the following error message
pQ9q254


<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>
pQ9q254
 
Last edited:
Upvote 0
You should pass Cl.Value and Fldr as arguments to the called sub:

Code:
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
 
Upvote 0
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>
 
Upvote 0
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:

Code:
Fileout.Write CellValue & ", " & FolderPath
 
Upvote 0
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.
 
Upvote 0
Your current code overwrites the text file each time. You could do something like this:

Code:
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
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top