B
bojan0810
Hi all!
I have this code
Sub Import2()
Dim qry As QueryTable
Dim FilNams As Variant
Dim FilNamCntr As Long
Dim strQryName As String
Dim LastRow As Long
Dim ContainerWB As Workbook
Dim msgString As String
FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select Textfile toImport", _
MultiSelect:=True)
'Check to see if any files were selected
If TypeName(FilNams) = "Boolean" Then
MsgBox "No Files Selected. Exiting Program."
Exit Sub
Else
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
End If
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
Next FilNamCntr
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
With ActiveSheet
On Error GoTo ErrorCatch:
'Append to previous data, if applicable
If .Range("A" & Rows.Count).End(xlUp).Row = 1 Then
LastRow = 1
Else
LastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End If
'MsgBox "LastRow value is:" & LastRow 'verification test
Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr),_
Destination:=.Range("A" & LastRow))
With qry
.Name = "Filename"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(14, 12, 11, 6, 6, 9, 7, 7)
.Refresh BackgroundQuery:=False
End With
End With
Next FilNamCntr
Exit Sub
ErrorCatch:
MsgBox "Unexpected Error. Type: " & Err.Description
End Sub
And its working great but, how to make that when you choose 2 files to import that second file is in second column(b) or if you have 3,4,5 etc files that every file is in other column (a b c d etc). And with this how to make not to seperate text from files into rows, that first file to import into A1 only, second file to B1, third to C1 and so on...
Thx
I have this code
Sub Import2()
Dim qry As QueryTable
Dim FilNams As Variant
Dim FilNamCntr As Long
Dim strQryName As String
Dim LastRow As Long
Dim ContainerWB As Workbook
Dim msgString As String
FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select Textfile toImport", _
MultiSelect:=True)
'Check to see if any files were selected
If TypeName(FilNams) = "Boolean" Then
MsgBox "No Files Selected. Exiting Program."
Exit Sub
Else
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
End If
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
Next FilNamCntr
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
With ActiveSheet
On Error GoTo ErrorCatch:
'Append to previous data, if applicable
If .Range("A" & Rows.Count).End(xlUp).Row = 1 Then
LastRow = 1
Else
LastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End If
'MsgBox "LastRow value is:" & LastRow 'verification test
Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr),_
Destination:=.Range("A" & LastRow))
With qry
.Name = "Filename"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(14, 12, 11, 6, 6, 9, 7, 7)
.Refresh BackgroundQuery:=False
End With
End With
Next FilNamCntr
Exit Sub
ErrorCatch:
MsgBox "Unexpected Error. Type: " & Err.Description
End Sub
And its working great but, how to make that when you choose 2 files to import that second file is in second column(b) or if you have 3,4,5 etc files that every file is in other column (a b c d etc). And with this how to make not to seperate text from files into rows, that first file to import into A1 only, second file to B1, third to C1 and so on...
Thx