Import several text files into an excel file with macro

[rhkm]

Hi everyone

I am assigned to find a way to be able to import a several text files into a single excel file in different sheets. So far I have been working on with this code I found online written by Allen Wyatt

Below is the 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

The code works nicely but there are a few modifications that I need:
1. When all the text files needed are successfully imported to the excel file, the cells containing the actual data are not set to contain numbers. even though they have numbers in them, the data type is not number.

2. The format of the text files is as the following

Frame reading 1 reading 2
1 numval numval
2 numval numval

and so on. "numval" meaning numerical value. I need to add another column between 'Frame' and 'reading 1' which contain the values from 1/80, 2/80, 3/80 and so on until the last row. And also having the column title as 'time' would be awesome.

3. Finally, I need to add a graph to the sheets. I need to add a graph of time vs reading 1 & reading 2. The graph needs to be a line graph. One thing that needs to be noted is that some of the text files have only two readings as in the example, but some of them has four readings.

Here is a few examples of the text files

10270

Please help me in any way. I would like to thank you in advance

Greetings
Reuben

[rhkm]

Also, I would like it to be able to open .csv files and also make graphs out of the imported csv files in the excel document

[lotuxel]

You can add the
Set rng = ActiveSheet.UsedRange
For Each r In rng
If InStr(1, r, ",") > 0 Then
r = Replace$(r.Value, ",", "")
End If
Next

before [ ExitHandler:]
and try it.
p.s.
not clear for the add one column for 1/80 2/80 (1 = ??/80=??)

[rhkm]

Hi Lotuxel,

Thank you for your help. But when I add the code you wrote nothing changes.

Also what I meant with the add one column is that the text files consist of 3 or 5 columns. The first column is the frame number which is 1 - 1200, and the 2nd to 5th columns are the values. I would like the macro to add a column between the first and the second column, containing (1/80 = 0.0125) in the first row, (2/80 = 0.0250) in the second and so on.

Another thing is, I was also asked to have it able to read also .csv files and .tda files. This is what I have come to:


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:="Comma-Separated Values Files (*.csv), *.csv, Text Files (*.txt), *.txt, Palm-To-Do Files (*.tda), *.tda", _
MultiSelect:=True, Title:="Files to Open")

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

'---------------------------------------------------------------------------------------------------

If TypeName(FilesToOpen) = *.csv
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:=True, _
Comma:=False, Space:=True, _
Other:=False, 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:=True, _
Comma:=False, Space:=True, _
Other:=False, OtherChar:=sDelimiter
End With
x = x + 1
Wend

'---------------------------------------------------------------------------------------------

ElseIf TypeName(FilesToOpen) = *.txt
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:=True, _
Comma:=False, Space:=True, _
Other:=False, 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:=True, _
Comma:=False, Space:=True, _
Other:=False, OtherChar:=sDelimiter
End With
x = x + 1
Wend

'-----------------------------------------------------------------------------------------------

ElseIf TypeName(FilesToOpen) = *.tda
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:=True, _
Other:=False, 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:=True, _
Other:=False, OtherChar:=sDelimiter
End With
x = x + 1
Wend

End If

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

ErrHandler:
MsgBox Err.Description
Resume ExitHandler


End Sub


What I'm trying to do is to have an If case for different file types chosen. The problem is that the code won't run and I can't find out what is wrong with the code.

I also would like to have a dialog box popping up when the user selects .tda files which asks them to choose between 7 or 25 microseconds. Then, if the user chose 25 then it makes 0 in C7, 0.00025 in C8, 0.00050 in C9 and so on. If the user chose 7 the 0 in C7, 0.00007 in C8, 0.00014 in C9 and so on.

Any kind of help would be greatly appreciated

Thanks in advance

[lotuxel]

Hi Rhkm,
I guess you better to attach the .csv, .tda and sample completed files to test, unless we also don't know where is wrong.
Rgs,
lotuxel

[rhkm]

Hi lotuxel,

in the attachment you'll find the sample files i wish to import to excel

10276

[lotuxel]

Try this for text file.

Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim rng As Range
Dim r As Range
Dim str_row As Long
Dim last_row As Long
Dim i As Long

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
With ActiveWorkbook
With ActiveSheet
Set rng = .UsedRange

For Each r In rng
If InStr(1, r, ",") > 0 Then
r = Replace$(r.Value, ",", "")
End If
Next
Range("b2").EntireColumn.Insert
str_row = 3
last_row = Cells(Rows.count, "A").End(xlUp).row
For i = str_row To last_row
Cells(i, 2).Formula = "=" & Cells(i, 1).Value & "/80"
Next
End With
End With

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox err.Description
Resume ExitHandler
End Sub


for csv and tda files are different structure and u can not use same macro. I don't understand exactly what you need for these.
the csv file come open in excel.
good luck!