Macro to Import Text Files into Seperate Sheet

krishhi

Active Member
Joined
Sep 8, 2008
Messages
328
Hi there,

I need some help on a Macro. I have more than 160 Text files, I need to copy the text files into seperate sheet of excel. You all know it is a time consuming.

Today I google for the macro, luckly i found this one:

Code:
Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

It works very well but the problem is that, In that text file, I have some numbers like 005654, 009845 etc.. When The macro copies the data from text file to excel, the numbers changed to 5654, 9845.

Is there any way to overcome this problem. I want to place all the exact data from text to excel without chaning its format.

Thanks in advance,
:)
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Switch on the macro recorder and use Text To Columns to specify that that column should be Text. Excel will include a FieldInfo argument that you can add to your existing code. Example for column 2:

Rich (BB code):
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 2), Array(3, 1))
 
Upvote 0
Here i added the last lines:

Code:
  wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
        2)), TrailingMinusNumbers:=True
 
Upvote 0
Code:
Part Nbr  Keyword Part Serial Nbr Task Nbr Description
00374250  MODULE  5000  31-11-09-900-801-71   NO. 1 BOOST MODULE 
00A050-06  0052542  27-90-01-900-801-01   LEFT FRONT POWER 4 MODULE 
00A050-06  MODULE  533  27-90-01-900-801-02   LEFT FRONT POWER 2 MODULE 
00A050-06  002548  535  27-90-01-900-801-15   LEFT FRONT POWER 3 MODULE 
00A050-06  MODULE  544  27-90-01-900-804-01   RIGHT REAR POWER 1 MODULE 
00A050-06  0002548  316  27-90-01-900-804-15   RIGHT REAR POWER 4 MODULE 
00A051-03  0000144 281  27-90-01-900-802-01   LEFT REAR POWER 3 MODULE 
00A051-03  MODULE  245  27-90-01-900-802-15   LEFT REAR POWER 2 MODULE 
00A051-03  MODULE  214  27-90-01-900-803-01   RIGHT FRONT POWER 4 MODULE 
00A051-03  2542224  301  27-90-01-900-803-14   RIGHT FRONT POWER 1 MODULE 
00A051-03  0000125 302  27-90-01-900-803-15   RIGHT FRONT POWER 3 MODULE 
013023-02  UNIT  51  27-91-05-900-801-01   TRIM UNIT
 
Upvote 0
Well the problem is not with the pipe character, the above macro copies the data from text files to excel. But it changes the number formats like 0005659 to 5659.
 
Upvote 0
The problem may not be with the pipe character, but your code is using it as the delimiter. So I need to see the data in the text file so that I can do some testing on parsing it.
 
Upvote 0

Forum statistics

Threads
1,214,845
Messages
6,121,902
Members
449,053
Latest member
Guy Boot

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