0

I have a vba-code to import multiple txt-files into excel. Every txt-file contains a few lines starting with #. This lines I would like to skip and begin the import at the first line without #.

The code I am using to import the files is the following:

Sub Import_Text_Files()
  Dim sPath As String
  Dim oPath, oFile, oFSO As Object
  Dim r, iRow As Long
  Dim wbImportFile As Workbook
  Dim wsDestination As Worksheet

  sPath = "C:\txt-files\"

  Set wsDestination = ThisWorkbook.Sheets("Daten")

  i = 1

  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oPath = oFSO.GetFolder(sPath)
  Application.ScreenUpdating = False

  For Each oFile In oPath.Files
    r = 4
    If LCase(Right(oFile.Name, 4)) = ".txt" Then
        Workbooks.OpenText fileName:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

        Set wbImportFile = ActiveWorkbook
        For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
            wbImportFile.Sheets(1).UsedRange.Rows(iRow).Copy wsDestination.Cells(r, i)
            r = r + 1
            End If
        Next iRow
        wbImportFile.Close False
        Set wbImportFile = Nothing
      End If
    i = i + 7

    Next oFile

  End Sub

I tried with INSTR but it didn't work.

Can anybody help me?

Froop
  • 99
  • 8
  • 2
    Why not import all into excel as shown [here](http://stackoverflow.com/questions/11267459/vba-importing-text-file-into-excel-sheet/11267603#11267603) and then use autofilter in excel to delete all lines starting with "#" Would be much faster than looping through every line in the text file? – Siddharth Rout Nov 07 '14 at 11:06
  • See the section `Open the text file in memory` in the link which I mentioned in the above comment – Siddharth Rout Nov 07 '14 at 11:06

1 Answers1

0

I found a solution to delete all empty cells and the cells starting with #

Sub Read_Text_Files()

    Dim sPath As String
    Dim oPath, oFile, oFSO As Object
    Dim r, iRow As Long
    Dim wbImportFile As Workbook
    Dim wsDestination As Worksheet

    sPath = "C:\Daten\"

    Set wsDestination = ThisWorkbook.Sheets("Daten")

    i = 1
    j = 1

    Set oFSO = CreateObject("Scripting.FileSystemObject")

        Set oPath = oFSO.GetFolder(sPath)
        Application.ScreenUpdating = False

        For Each oFile In oPath.Files
        r = 4

            If LCase(Right(oFile.Name, 4)) = ".txt" Then

                Workbooks.OpenText fileName:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _
                TrailingMinusNumbers:=True

                Set wbImportFile = ActiveWorkbook
                For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
                    wbImportFile.Sheets(1).UsedRange.Rows(iRow).Copy wsDestination.Cells(r, i)
                    r = r + 1
                Next iRow
                wbImportFile.Close False
                Set wbImportFile = Nothing
            End If
        i = i + 7
        j = j + 1

    Next oFile

    Dim rng As Range

    Set rng = ActiveCell

    For k = 1 To wsDestination.UsedRange.Columns.Count
        For l = 1 To 20
            wsDestination.Cells(4, k).Select

            If IsEmpty(wsDestination.Cells(4, k)) Then
                Cells(4, k).Delete xlShiftUp
            End If

            If InStr(wsDestination.Cells(4, k).Value, "#") = 0 Then
            Else
                Cells(4, k).Delete xlShiftUp
            End If
        Next l
    Next k

End Sub
Froop
  • 99
  • 8