Link to home
Start Free TrialLog in
Avatar of obad62
obad62

asked on

Excel Macro to insert txt files in a patch

Hi Expert,

I receive everyday a number of txt files I like to use Excel Macro to insert all in tables
Attached sample txt and a picture to show what to inculde in the excel sheet
7.txt
2.txt
9.txt
sample-txt.JPG
Avatar of Ivo Stoykov
Ivo Stoykov
Flag of Bulgaria image

the txt files are not well formated (suitable for Excel). columns are delimited with multiple spaces

for import in excel you could use this
    ChDir "F:\"
    Workbooks.OpenText FileName:="F:\7.txt", Origin:=xlWindows, StartRow:=1, _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, _
        Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Open in new window

in OpenText FileName put your path or pass it as a parameter

HTH

Ivo Stoykov
Avatar of obad62
obad62

ASKER

Hi Ivo Stoykov ,

am not that good with codes and how to make in excel. kindly would please make it in Excel sheet.  I appreciate your help.

Obad
Find Macros in Tools menu or Development Tab and click it
Write a name for the macro and click Create
Copy / Paste the code above
Switch to excel (or save it somewhere - not mandatory)
Find Macros in Tools menu or Development Tab and click it
Select created macro and click Run button

That's it

HTH

Ivo Stoykov
Avatar of obad62

ASKER

Here what I got. attached pic
macro-error.JPG
Replace these what is between quotation marks
ChDir "F:\"    ' with drive letter where you files are
Workbooks.OpenText FileName:="F:\7.txt", ' with the file name you want to to import

Open in new window


HTH

Ivo Stoykov
Avatar of obad62

ASKER

errors
??? some messages? what is the error? which Excel version are you using? Are macros allowed?
Avatar of obad62

ASKER

I've requested that this question be deleted for the following reason:

incorrect answer
Avatar of Saqib Husain
Are you still interested in a solution?
Avatar of obad62

ASKER

Hi ssaqibh,

I wish you can help.
Going to attempt based on OP's desire.
I repeat IvoStoykov's proposal with slight modification

Sub readtxtfile()
    fnam = Application.GetOpenFilename
    Application.Workbooks.OpenText fnam
End Sub

Open in new window


Please tell how this fares
This routine will only pull out the table data. This can also add the data below the previous data.

Sub readtextfile()
    Dim sl As Variant
    loca = Array(1, 17, 34, 37, 39, 60, 68)
    lena = Array(16, 17, 2, 2, 21, 8, 17)
    'fnam = "C:\Documents and Settings\Administrator\My Documents\7.txt"
    fnam = Application.GetOpenFilename
    Application.Workbooks.OpenText fnam
    If fnam <> False Then
        Open fnam For Input As #1
            Do While Not EOF(1)
                Line Input #1, rline
                If IsNumeric(Left(rline, 4)) Or Left(rline, 6) = "Number" Then
                    nr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                    If Left(rline, 6) = "Number" Then nr = nr + 1
                    For i = 0 To 6
                        Cells(nr, i + 1) = Trim(Mid(rline, loca(i), lena(i)))
                    Next i
                End If
            Loop
        Close 1
    End If
End Sub

Open in new window

Avatar of obad62

ASKER

Hi saaqib,

thank you for this good trick, I copied the 2nd one & use it. But the out still giving me that repated raws as attached. I need the out put to be only tables.

thank you.
1.JPG
Sorry try this

Sub readtextfile()
    Dim sl As Variant
    loca = Array(1, 17, 34, 37, 39, 60, 68)
    lena = Array(16, 17, 2, 2, 21, 8, 17)
    fnam = Application.GetOpenFilename
    If fnam <> False Then
        Open fnam For Input As #1
            Do While Not EOF(1)
                Line Input #1, rline
                If IsNumeric(Left(rline, 4)) Or Left(rline, 6) = "Number" Then
                    nr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                    If Left(rline, 6) = "Number" Then nr = nr + 1
                    For i = 0 To 6
                        Cells(nr, i + 1) = Trim(Mid(rline, loca(i), lena(i)))
                    Next i
                End If
            Loop
        Close 1
    End If
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Saqib Husain
Saqib Husain
Flag of Pakistan image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial