using a macro to import text files one underneath the other

[katherinec]

Hi,

I have just begun to program and write simple scripts. I have made a simple macro to import a series of text files by looping the procedure and changing the directory name each time. The text files however are imported into Excel next to each other and I want them to be underneath each other. The code is:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\HIPOCAS\WindData_AnnMarie\1994\199401\HIRLAM-1994.A1", Destination:= _
Range("A1"))
.Name = "HIRLAM-1994.A1"
.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, 9, 9, 9, 9, 9)
.TextFileFixedColumnWidths = Array(8, 10, 11, 10, 8, 4, 12)
.Refresh BackgroundQuery:=False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\HIPOCAS\WindData_AnnMarie\1994\199402\HIRLAM-1994.A1", Destination:= _
Range("A1"))
.Name = "HIRLAM-1994.A1"
.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, 9, 9, 9, 9, 9)
.TextFileFixedColumnWidths = Array(8, 10, 11, 10, 8, 4, 12)
.Refresh BackgroundQuery:=False


End With

Is there a simple way of formatting the code so that each text file is importing below the previous?

many thanks,

Katherine

 

[pfarmer]

Re: using a macro to import text files one underneath the ot

Hi,

I have just begun to program and write simple scripts. I have made a simple macro to import a series of text files by looping the procedure and changing the directory name each time. The text files however are imported into Excel next to each other and I want them to be underneath each other. The code is:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\HIPOCAS\WindData_AnnMarie\1994\199401\HIRLAM-1994.A1", Destination:= _
Range("A1"))
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\HIPOCAS\WindData_AnnMarie\1994\199402\HIRLAM-1994.A1", Destination:= _
Range("A1"))

Is there a simple way of formatting the code so that each text file is importing below the previous?

many thanks,

Katherine

Katherine,

In this example one text file is loaded followed by a second. The code certainly could be cleaned up but seems to work fine. The file names are derived by a couple of cells on a sheet named Setup.

The column width is something like 61 or so but this could be changed on files with set column widths.

In any case the secret to doing this is to import one file, then test for the last row that was used.

Add one to that row result and load in the second text file starting at that row number.

I also do sorts and call a couple of other routines, just ignore those:

Public Sub ImportForm(FName As String, Sep As String, ws As Worksheet)

Dim CountFields As Single
Dim FieldVector() As String
Dim iCELL As Range
Dim i As Integer
Dim iROW As Single
Dim RowNdx As Integer
Dim wb
Dim WholeLine As String, WholeFile As String
Dim z As Integer

On Error GoTo EndMacro

wb = ThisWorkbook.Name

Set ws = Workbooks(wb).Worksheets("Forms")

i = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

RowNdx = i

z = 0

Open FName For Input Access Read As #1

While Not EOF(1)
    
z = z + 1

    Line Input #1, WholeLine
    
    If Right(WholeLine, 1) <> Sep Then
        
        WholeLine = WholeLine & Sep
    
    End If
    
    CountFields = Len(WholeLine) - Len(Replace(WholeLine, "|", ""))

    For iROW = 1 To CountFields / 60
        
        FieldVector = Split(WholeLine, Sep, 61)
        
        ws.Range(ws.Cells(RowNdx, 2), ws.Cells(RowNdx, 1 + UBound(FieldVector))) = FieldVector
        
        For Each iCELL In ws.Range(ws.Cells(RowNdx, 2), ws.Cells(RowNdx, 1 + UBound(FieldVector)))
            
            iCELL = Trim(iCELL) 'Remove Left and Right Spaces
 
        Next iCELL
        
        If CountFields > 60 * iROW Then

            WholeLine = FieldVector(UBound(FieldVector))
        
        End If
        
        RowNdx = RowNdx + 1
        
        Erase FieldVector
    
    Next iROW

ws.Range("BY2") = z

Wend

EndMacro:

On Error GoTo 0

Close #1

End Sub

Public Sub DoTheImport()

Dim CFName As Variant
Dim FName As Variant
Dim i As Integer
Dim Sep As String
Dim wb
Dim ws As Worksheet

On Error GoTo EndMacro

Set ws = ThisWorkbook.Worksheets("Forms")

i = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FName = ThisWorkbook.Worksheets("Setup").Range("c19")

CFName = ThisWorkbook.Worksheets("Setup").Range("c18")

FileCopy CFName, FName

Kill CFName

Sep = "|"

ws.Range("b" & i, "bz4650").ClearContents

ImportForm CStr(FName), Sep, ws

Kill FName

EndMacro:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
Public Sub ImportFormAll(FName As String, Sep As String, ws As Worksheet)

Dim RowNdx As Integer
Dim WholeLine As String, WholeFile As String
Dim FieldVector() As String
Dim iROW As Single
Dim CountFields As Single
Dim iCELL As Range

On Error GoTo EndMacro

RowNdx = 4

Open FName For Input Access Read As #1

While Not EOF(1)
    
    Line Input #1, WholeLine
    
    If Right(WholeLine, 1) <> Sep Then
        
        WholeLine = WholeLine & Sep
    
    End If
    
    CountFields = Len(WholeLine) - Len(Replace(WholeLine, "|", ""))

    
    For iROW = 1 To CountFields / 60
        
        FieldVector = Split(WholeLine, Sep, 61)
        
        ws.Range(ws.Cells(RowNdx, 2), ws.Cells(RowNdx, 1 + UBound(FieldVector))) = FieldVector
        
        For Each iCELL In ws.Range(ws.Cells(RowNdx, 2), ws.Cells(RowNdx, 1 + UBound(FieldVector)))
            
            iCELL = Trim(iCELL) 'Remove Left and Right Spaces

        Next iCELL
        
        If CountFields > 60 * iROW Then

            WholeLine = FieldVector(UBound(FieldVector))
        
        End If
        
        RowNdx = RowNdx + 1
        
        Erase FieldVector
    
    Next iROW

Wend

EndMacro:

On Error GoTo 0

Close #1

End Sub

Public Sub DoTheImportAll()

Dim FName As Variant
Dim i As Integer
Dim Sep As String
Dim ws As Worksheet

On Error GoTo EndMacro

Set ws = ThisWorkbook.Worksheets("Forms")

If ws.Range("BY2") > 0 Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FName = ThisWorkbook.Worksheets("Setup").Range("c21")

Sep = "|"

ws.Range("b4:bz4650").ClearContents

ImportFormAll CStr(FName), Sep, ws

i = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

vArrayOne = ws.Range("ca4", "cc" & i).Value
ws.Range("bx4", "bz" & i).Value = vArrayOne

UpdateStatus
UpdateLocation

EndMacro:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

For the part of determining the last row used:

----------------------
Dim i As Integer
Dim wb
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("YourSheetName")
-----------------------
'or

'wb=ThisWorkBook

'Set ws = wb.Worksheets("YourSheetName")

You need to replace YourSheetName with the name of the sheet in your file

In any case I like to set the reference to ThisWorkBook. That way if
you have a macro that automatically runs on a timer and you
have a second workbook open the macro will run on the correct workbook.
The same goes for avoiding activesheet, reference the correct sheet.

--------------------------------------

i = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

RowNdx = i

----------------------------------------

Now in your case you start your import at range("A1") For the first file. For the second file you would start your import at range("A" & RowNdx). Without going back and looking at your code, I think just insert the code I have between the lines prior to your import code and change the second range statement with what I have listed here - range("A" & RowNdx).

Note that in my code I use cell statements instead of the range and also with the range statement. I find these easier to deal with depending on what you are trying to do. Note the difference in reference for location.

ws.Range("A1") is the same as:
ws.Cells(1,1)

ws.Range("A2") is the same as:
ws.Cells(2,1)

The rows and columns are swapped. If you are incrementing the columns I find it is often easier to do so using the Cell statement

Also it looks like you just did a recorded macro, you may want to do a search on this site and/or others for importing text files as there as possibly better ways of doing this, depending on the text file formats, etc.

Perry