ExcelBanter - VBA for Importing Text Files

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - VBA for Importing Text Files (https://www.excelbanter.com/excel-programming/382202-vba-importing-text-files.html)

VBA for Importing Text Files

My Current VBA for import test files are as follow, how can I select mutiple
files at one time instead of clicking one by one? Ctrl and Shift button does
not work in this. Thanks.

Sub Import()

Dim myFileName As Variant

Do

myFileName = Application.GetOpenFilename( _
filefilter:="Text Files, *.Txt", Title:="Locate & Select
the Reel No.")
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

Martin,
Check the help for the MultiSelect argument to GetOpenFilename .
Note that you get an array returned, that you can then loop through.

NickHK

"Martin" wrote in message
...
My Current VBA for import test files are as follow, how can I select
mutiple
files at one time instead of clicking one by one? Ctrl and Shift button
does
not work in this. Thanks.

Sub Import()

Dim myFileName As Variant

Do

myFileName = Application.GetOpenFilename( _
filefilter:="Text Files, *.Txt", Title:="Locate &
Select
the Reel No.")
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope
Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

I can select multiple files now but nothing was imported. Whats wrong? The
code is a follows:

Sub Import()

Dim myFileName As Variant

Do

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

martin,
What is "fileToOpen" ? You mean myFileName

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then

Do you mean:
myFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , , ,
True)
If myFileName = False Then

Also, as I said, this will return an array that you need to loop through.
Dim i as long
for i=lbound(myFileName) to ubound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName(i), _
Destination:=Range("A1"))
'etc....

And remove your current Do..Loop

This puts all the querytables onto of each other. Is that what you want ?

NickHK

"Martin" wrote in message
...
I can select multiple files now but nothing was imported. Whats wrong? The
code is a follows:

Sub Import()

Dim myFileName As Variant

Do

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope
Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

I try tomorrow. Going off now. Thanks.

"NickHK" wrote:

martin,
What is "fileToOpen" ? You mean myFileName

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then

Do you mean:
myFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , , ,
True)
If myFileName = False Then

Also, as I said, this will return an array that you need to loop through.
Dim i as long
for i=lbound(myFileName) to ubound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName(i), _
Destination:=Range("A1"))
'etc....

And remove your current Do..Loop

This puts all the querytables onto of each other. Is that what you want ?

NickHK

"Martin" wrote in message
...
I can select multiple files now but nothing was imported. Whats wrong? The
code is a follows:

Sub Import()

Dim myFileName As Variant

Do

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope
Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

Hi Nick,

I got the error "For without next". My code according to your suggestion a

Sub Import()

Dim myFileName As Variant

myFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt",
, , , True)
If myFileName = False Then

Dim i As Long
For i = LBound(myFileName) To UBound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub

"NickHK" wrote:

martin,
What is "fileToOpen" ? You mean myFileName

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then

Do you mean:
myFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , , ,
True)
If myFileName = False Then

Also, as I said, this will return an array that you need to loop through.
Dim i as long
for i=lbound(myFileName) to ubound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName(i), _
Destination:=Range("A1"))
'etc....

And remove your current Do..Loop

This puts all the querytables onto of each other. Is that what you want ?

NickHK

"Martin" wrote in message
...
I can select multiple files now but nothing was imported. Whats wrong? The
code is a follows:

Sub Import()

Dim myFileName As Variant

Do

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope
Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub

VBA for Importing Text Files

Martin,
Yes, the error message is telling you what is wrong; add a Next after your
"End with" to complete the loop.
Also, note that myFileName is an array, so you have to address its elements
as myFileName(i).

NickHK

"Martin" wrote in message
...
Hi Nick,

I got the error "For without next". My code according to your suggestion
a

Sub Import()

Dim myFileName As Variant

myFileName = Application.GetOpenFilename("Text Files
(*.txt),*.txt",
, , , True)
If myFileName = False Then

Dim i As Long
For i = LBound(myFileName) To UBound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub

"NickHK" wrote:

martin,
What is "fileToOpen" ? You mean myFileName

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then

Do you mean:
myFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , ,
,
True)
If myFileName = False Then

Also, as I said, this will return an array that you need to loop
through.
Dim i as long
for i=lbound(myFileName) to ubound(myFileName)
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName(i), _
Destination:=Range("A1"))
'etc....

And remove your current Do..Loop

This puts all the querytables onto of each other. Is that what you want
?

NickHK

"Martin" wrote in message
...
I can select multiple files now but nothing was imported. Whats wrong?
The
code is a follows:

Sub Import()

Dim myFileName As Variant

Do

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt),*.txt", , , , True)
If myFileName = False Then
MsgBox "End of Import. Copy Worksheet to Smartscope
Summary.xls"
'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

.Name = "smartscope"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Loop Until myFileName = False

End Sub