importing txt file help needed

[Guest]

Hello. I have the following code (thanks to Ron de Bruin) and am trying to
adapt it to my needs. What I have to do is to have the information go across
the spreadsheet columns rather then straight down the worksheet. There are 4
columns of info, skip a column, then 4 more, and so on. The code has it all
in one column down the worksheet. I seek the wisdom of the newsgroup to see
where and what needs to be added, replaced, etc as I am at a loss. I'm
guessing it is in the Workbooks.OpenText The code is lengthy.
Thanks in advance for any assistance providede.
.... John

Sub Merge_TXT_Files()
Dim BatFileName As String
Dim TXTFileName As String
Dim XLSFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim DefPath As String
Dim Wb As Workbook
Dim oApp As Object
Dim oFolder
Dim foldername

'Create two temporary file names
BatFileName = Environ("Temp") & "\CollectTXTData" & Format(Now,
"dd-mm-yy-h-mm-ss") & ".bat"
TXTFileName = Environ("Temp") & "\AllTTXT" & Format(Now,
"dd-mm-yy-h-mm-ss") & ".txt"

'Folder where you want to save the Excel file
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Set the extension and file format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else

'You use Excel 2007
'FileExtStr = ".xlsx": FileFormatNum = 51

'If you want to save as xls(97-2003 format) in 2007 use
FileExtStr = ".xls": FileFormatNum = 56
End If

'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterTXT " & Format(Now, "dd-mmm-yyyy
h-mm-ss") & FileExtStr

'Browse to the folder with TXT files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with TXT files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If

'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*.txt" _
& Chr(34) & " " & TXTFileName
Close #1

'Run the Bat file to collect all data from the TXT files into a TXT file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no txt files in this folder"
Kill BatFileName
Exit Sub
End If

'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText _
Filename:=TXTFileName, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(3, 4))


'Save text file as a Excel file
Set Wb = ActiveWorkbook

Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
Application.DisplayAlerts = True

Wb.Close savechanges:=False
MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName

'Delete the bat and text file you used temporarily
Kill BatFileName
Kill TXTFileName

Application.ScreenUpdating = True
End If

End Sub

 

[Ron de Bruin]

Hi John

You can's use this example then

We can adapt the code from this page
http://www.rondebruin.nl/txtcsv.htm

Try this tester
I assume that you only import 4 columns
See the code how you can skip columns

Copy the code below in a normal module of a workbook


Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_TXT_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim mysheet As Worksheet
Dim basebook As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim I As Integer

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)

I = 1
'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Cells(1, I))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False

'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 1, 1, 1)

'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9

' Get the data from the txt file
.Refresh BackgroundQuery:=False

End With
I = I + 5
Next Fnum


CleanUp:
For Each QTable In ActiveSheet.QueryTables
QTable.Delete
Next

ChDirNet SaveDriveDir

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub

 

[Guest]

Mr. de Bruin, this is exactly what I needed. Outstanding.
Thank you very much.
.... John

 

[Ron de Bruin]

You are welcome John

 

[Guest]

Mr de Bruin, hate to impose for one last thing. Where (and what) do I use to
have the information come into the same workbook that the code is in?

This should be the last request.

.... John

 

[Ron de Bruin]

Hi John

You can remove this line

Set basebook = Workbooks.Add(xlWBATWorksheet)

It will copy the data in the activesheet then