Import TXT files VBA please help

[roberttkim]

Hey everyone,

I have a code that works great for importing multiple txt files and copying into one sheet in excel but I have a problem was hoping one of you experts can help with. One of the txt files we have sometimes gets copied into one cell. I'm thinking it's a delimiting issue on the original file? Every other file gets copied fine though. Would really appreciate the help.

Sub test()
    Dim myDir As String, fn As String, txt As String, x
    myDir = "\\04vfile002\TREASOPS\Fixed Income and Treasury Operations\FedMail\09-2017" '<- change to actual folder path
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & "" & fn).ReadAll
        x = Application.Transpose(Split(txt, vbCrLf))
        Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
        fn = Dir()
    Loop
End Sub

 

[Rick Rothstein]

HOne of the txt files we have sometimes gets copied into one cell. I'm thinking it's a delimiting issue on the original file?

That would be my guess. You are Split'ting on vbCrLf, so it sounds like that file is not using vbCrLf as its end of line marker. If you source was from a Mac or Linux/Unix computer, I would expect the problem you are reporting. PC's use vbCrLf as the end of line marker... Macs use vbCr and Linux/Unix uses vbLf for that. You could test the "txt" variable using the InStr function to see what end of file marker is in use (test vbCrLf first) and then Split the text using whichever one you find in use.

 

[roberttkim]

Rick thanks for your help. I think that is the problem. The entire content from that one text file is copied into one cell while the others are fine. How would you adjust the code to be able to accept both vbCR. I think it may be coming from a Mac.

 

[Rick Rothstein]

How would you adjust the code to be able to accept both vbCR. I think it may be coming from a Mac.

I guess the simplest thing (although may time consuming for a huge file) is to use VB's Replace function to replace all vbCr characters with vbLf characters, then replace all double Line Feeds (vbLf & vbLf) with single vbLf characters... then split the text on the remaining vbLf characters. That should work no matter where the file comes from. For the code you posted in Message #1 , insert this line of code...

txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)

immediately after you assign the entire file to the txt variable.

 

[roberttkim]

Rick,

Thanks again but I'm sorry I just picked up this code from googling. I have no idea where to put your code "txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)" in the code I attached.

 

[Rick Rothstein]

Rick,

Thanks again but I'm sorry I just picked up this code from googling. I have no idea where to put your code "txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)" in the code I attached.

Where I show in red below...

[table="width: 500"]
[tr]
	[td]Sub test()
    Dim myDir As String, fn As String, txt As String, x
    myDir = "\\04vfile002\TREASOPS\Fixed Income and Treasury Operations\FedMail\09-2017" '<- change to actual folder path
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & "" & fn).ReadAll
        [B][COLOR="#FF0000"]txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)[/COLOR][/B]
        x = Application.Transpose(Split(txt, vbCrLf))
        Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
        fn = Dir()
    Loop
End Sub[/td]
[/tr]
[/table]

 

[Domenic]

As an aside, I would suggest creating only one instance of the FileSystemObject, and then using that same instance to open the TextStream for each file, instead of creating a new instance each time. It should be more efficient. Maybe something like this...

[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] test()
    [COLOR=darkblue]Dim[/COLOR] myDir [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], fn [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], x
    [COLOR=darkblue]Dim[/COLOR] fso [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR] [COLOR=green]'filesysteobject[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ts [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR] [COLOR=green]'textstream[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] fso = CreateObject("Scripting.FileSystemObject")
    
    myDir = "\\04vfile002\TREASOPS\Fixed Income and Treasury Operations\FedMail\09-2017" [COLOR=green]'<- change to actual folder path[/COLOR]
    [COLOR=darkblue]If[/COLOR] Right(myDir, 1) <> "\" [COLOR=darkblue]Then[/COLOR]
        myDir = myDir & "\"
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    fn = Dir(myDir & "\*.txt")
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] fn <> ""
        [COLOR=darkblue]Set[/COLOR] ts = fso.OpenTextFile(myDir & fn)
        txt = ts.ReadAll
        ts.Close
        txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)
        x = Application.Transpose(Split(txt, vbCrLf))
        Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
        fn = Dir()
    [COLOR=darkblue]Loop[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] fso = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] ts = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

 

[roberttkim]

Thanks Domenic but all the contents of the txt file is still being copied over into once cell. Rick's suggestion gives me a file not found error. Thanks for all your help. I'm really stumped and do appreciate it.

 

[Domenic]

The error is due to a missing backslash (\) between the path and filename used to open the text file.

Rick's suggestion to use Replace was a good one. I'm surprised it didn't work.

Try his other suggestion. First, place your cursor within the procedure, and then step through the code line by line by press the F8 key. Once the text from the file has been assigned to the variable "txt", stop and use InStr to test which end of line marker is being used. As Rick suggested, test for vbCrLf first. For example, to test it, type the following line in the Immediate Window and press Enter...

? instr(1, txt, vbCrLf)

 

[Rick Rothstein]

Rick's suggestion to use Replace was a good one. I'm surprised it didn't work.

Maybe because I forgot to follow it up by changing the red highlighted vbCrLf to vbLf in the next line. Once the OP makes that change and adds the missing backslash you pointed out, the code should work.

[table="width: 500"]
[tr]
	[td]Sub test()
    Dim myDir As String, fn As String, txt As String, x
    myDir = "\\04vfile002\TREASOPS\Fixed Income and Treasury Operations\FedMail\09-2017" '<- change to actual folder path
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & "[B][COLOR="#FFA07A"][/COLOR][/B]" & fn).ReadAll
        [B][COLOR="#FFA07A"]txt = Replace(Replace(txt, vbCr, vbLf), vbLf & vbLf, vbLf)[/COLOR][/B]
        x = Application.Transpose(Split(txt, [B][COLOR="#FF0000"][SIZE=3]vbCrLf[/SIZE][/COLOR][/B]))
        Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
        fn = Dir()
    Loop
End Sub[/td]
[/tr]
[/table]