Help in VBA code!

[Martin]

I have recorded a macro and added some codes for user selecting a file to
import. However when I run there is a double import of text files. Original
VBA after import works well and as follows:

Sub Macro1()


With
ActiveSheet.QueryTables.Add(Connection:="TEXT;E:\FCI\smartscope.txt", _
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

Then I modified the VBA to:

Sub Macro1()

Dim myFileName As Variant

myFileName = Application.GetOpenFilename(filefilter:="Text Files,
*.Txt", Title:="Pick a File")

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.OpenText Filename:=myFileName '


With
ActiveSheet.QueryTables.Add(Connection:="TEXT;E:\FCI\smartscope.txt", _
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

What is wrong with the code?

 

[Ardus Petus]

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))

HTH

 

[Martin]

It works thanks! My next step is to loop it so that I can import another
simlar text file at the end of the row after 1st import. How should I code it?

 

[Bob Phillips]

Dim myFileName As Variant

Do

myFileName = Application.GetOpenFilename( _
filefilter:="Text Files, *.Txt", Title:="Pick a File")
If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))
...
End With
End If

Loop Until myFilename = False

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Martin]

Wow its great! It is possible to import them continous in row instead of
column?

 

[Bob Phillips]

One way

Dim myFileName As Variant
Dim iLastRow As Long
Do

myFileName = Application.GetOpenFilename( _
filefilter:="Text Files, *.Txt", Title:="Pick a File")
If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Else
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & myFileName, _
Destination:=Range("A1"))
.Refresh
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & iLastRow).Copy
Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Columns(1).Delete
Application.ScreenUpdating = True
End With
End If

Loop Until myFileName = False



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)