Problem with import of txt file

[hendrikbez]

I have got this code, but when I run it it does not work. The problem can be I use Fixed width, when I import the file
Gives error on

          wrarr = Split(rearr(rec), delim)

All I need is to import the file to where I need it.

Sub ReadTxtFile()

Dim ws As Worksheet
Dim rearr(), wrarr()
Dim fName As String
Dim rowno As Long, colno As Long, rec As Long
Dim cnt As Long, cnt2 As Long
Dim delim As String

Set ws = Worksheets("UnixO")
fName = "C:\Do_It\test\UnixO Tapes.txt"

delim = ","
ifnum = FreeFile

rowno = 1  'row 1
colno = 1  'col A

    With ws
        Open fName For Input Access Read As #ifnum
            rec = 0
                Do While Not EOF(ifnum)
                    Line Input #ifnum, tmpvar
                    rec = rec + 1
                    
                    ReDim Preserve rearr(1 To rec)
                    rearr(rec) = tmpvar
                    
                    wrarr = Split(rearr(rec), delim)
                    cnt2 = UBound(wrarr)
                        
                        For cnt = 0 To cnt2
                            ws.Cells(rowno, colno + cnt) = wrarr(cnt)
                        Next cnt
                     rowno = rowno + 1
                Loop
            Close #ifnum
    End With
End Sub

 

[hendrikbez]

looks like no one can help me with this at all.
any idea to do this

 

[S_Wish]

try to add after

 ReDim Preserve rearr(1 To rec)

that line

 ReDim Preserve wrarr(1 To rec)

 

[S_Wish]

also, if you want to get all before delimiter, you need to write 0 after, and if you want to get all after delimiter - write 1 after

 wrarr(rec) = Split(rearr(rec), delim)(0)

so if you have 1,34
then wrarr(rec)=1

 

[S_Wish]

and may be you have a lot of delimiters, so try that

...
cnt2 = 0
    With ws
        Open fName For Input Access Read As #ifnum
            rec = 0
                Do While Not EOF(ifnum)
                    Line Input #ifnum, tmpvar
                    rec = rec + 1
                    
                    ReDim Preserve rearr(1 To rec)
                    rearr(rec) = tmpvar
                    cnt2 = Len(rearr(rec)) - Len(Substitute(rearr(rec), delim, ""))
                    ReDim wrarr(0 To cnt2)
                    For i = 0 To cnt2 - 1
                    wrarr(i) = Split(rearr(rec), delim)(i)
                    Next i
                        
                        For cnt = 0 To cnt2
                            ws.Cells(rowno, colno + cnt) = wrarr(cnt)
                        Next cnt
                     rowno = rowno + 1
                Loop
            Close #ifnum
    End With
...

 

[hendrikbez]

S_Wish

Nearly there, just gives error on this line, something about Substitute

cnt2 = Len(rearr(rec)) - Len([B][COLOR=#ff0000]Substitute[/COLOR][/B](rearr(rec), delim, ""))

here are the code I am using

Sub ReadTxtFile()

Dim ws As Worksheet
Dim rearr(), wrarr()
Dim fName As String
Dim rowno As Long, colno As Long, rec As Long
Dim cnt As Long, cnt2 As Long
Dim delim As String

Set ws = Worksheets("UnixO")
fName = "C:\Do_It\test\UnixO Tapes.txt"
delim = ","  'for Tab delimiter use delim = Chr(9)
ifnum = FreeFile
rowno = 1  'row 1
colno = 1  'col A

cnt2 = 0
    With ws
        Open fName For Input Access Read As #ifnum
            rec = 0
                Do While Not EOF(ifnum)
                    Line Input #ifnum, tmpvar
                    rec = rec + 1                    
                    ReDim Preserve rearr(1 To rec)
                    rearr(rec) = tmpvar
                    cnt2 = Len(rearr(rec)) - Len(Substitute(rearr(rec), delim, ""))
                    ReDim wrarr(0 To cnt2)
                    For i = 0 To cnt2 - 1
                    wrarr(i) = Split(rearr(rec), delim)(i)
                    Next i                        
                        For cnt = 0 To cnt2
                            ws.Cells(rowno, colno + cnt) = wrarr(cnt)
                        Next cnt
                     rowno = rowno + 1
                Loop
            Close #ifnum
    End With

 

[S_Wish]

sorry, my bad, you can use one of that:

cnt2 = Len(rearr(rec)) - Len(Replace(rearr(rec), delim, ""))
cnt2 = Len(rearr(rec)) - Len(WorksheetFunction.Substitute(rearr(rec), delim, ""))

 

[hendrikbez]

sorry, my bad, you can use one of that:

cnt2 = Len(rearr(rec)) - Len(Replace(rearr(rec), delim, ""))
cnt2 = Len(rearr(rec)) - Len(WorksheetFunction.Substitute(rearr(rec), delim, ""))

S_Wish

The is no problem, it is running for a few seconds, but there is no data on the sheet that I want it to be, Am I doing something stupid or is there
more code to get this to show on the sheet.

 

[S_Wish]

can you provide 1 row of your input file?

 

[hendrikbez]

Here are the first few rows of my text file

1. row 1 always empty
2. there is info in row 2
3. row 3 and 4 always empty
4. all rows will have info in them from row 5
5. It does not show here really how it looks in the text fie, I cannot attach the text file



661 Volumes (0 selected)

Media ID Volume Pool Last Written Data Expiration Kilobytes Robot Type Slot Media Status
--------------------------------------------------------------------------------------------------------------------
PRA054 LTODaily 07/12/2017 14:09:41 07/26/2017 14:09:41 117792 TLD 20 Active
PRA020 NetBackup 07/12/2017 12:27:53 07/19/2017 12:27:53 48062048 TLD 29 Active
NSW044 NetBackup 07/12/2017 12:00:08 07/19/2017 12:00:08 59934432 TLD 15 Active
NJQ000 NetBackup 07/12/2017 12:00:03 07/19/2017 12:00:03 47927104 TLD 7 Active
AAG672 CatalogBackup 07/12/2017 04:04:50 07/26/2017 04:04:50 710048845 TLD 45 Active
PRA103 LTODaily 07/11/2017 14:08:14 07/25/2017 14:08:14 133792 NONE Active
NSW026 NetBackup 07/11/2017 12:13:20 07/18/2017 12:13:20 49351232 NONE Active
UNO110 NetBackup 07/11/2017 12:00:08 07/18/2017 12:00:08 59802912 NONE Active
NJQ057 NetBackup 07/11/2017 12:00:02 07/18/2017 12:00:02 49216384 NONE Active
UNO137 LTODaily 07/10/2017 14:16:56 07/24/2017 14:16:56 119424 NONE Active
PRA010 NetBackup 07/10/2017 12:11:30 07/17/2017 12:11:30 49349344 NONE Active
NSW068 NetBackup 07/10/2017 12:00:06 07/17/2017 12:00:06 49214624 NONE Active
NJQ018 NetBackup 07/10/2017 12:00:02 07/17/2017 12:00:02 59805280 NONE Active
NSW040 LTODaily 07/08/2017 06:09:14 07/22/2017 06:09:14 27293440 NONE Active