Reference Text File To Import Using Generic Letter or Number

Hello R_S_6,

This version of your macro allows you to insert the file names into an array. Here the names are hard coded into the macro. The file names could be read from a sheet in the macro is running in. I would need to know what the sheet name is and the available column to have the macro read the file names in automatically.

Sub Import_dat_Modify_Export_csv()
'
'
' Macro to save *.dat files in *.csv format while removing the un-needed data at the top of the *.dat files
  '1
  
  Dim FileName As String
  Dim Files(30) As String
  Dim I As Long
      
      Files(0) = "ABC1.dat"
      Files(1) = "ABC2.dat"
      Files(3) = "ABC3.dat"
     
        Do While Files(I) <> ""
          FileName = Split(File(I), ".")(0)
          With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;D:\TEMP\DIR\" & Files(I) _
            , Destination:=Range("A1"))
            .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 = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
          End With
          Rows("1:19").Select
          Selection.Delete Shift:=xlUp
          Range("A1").Select
          ChDir "D:\TEMP\X123"
          ActiveWorkbook.SaveAs FileName:= _
              "D:\TEMP\X123\" & FileName & ".csv" _
              , FileFormat:=xlCSV, CreateBackup:=False
          ActiveWindow.Close
          Workbooks.Add
          I = I + 1
          QueryTables(1).Delete
        Loop
        
End Sub

Sincerely,
Leith Ross

Just had a go with the code you provided. (Although I prefer your idea of the file names in a sheet!)

I had to modify this line:

FileName = Split(File(I), ".")(0)

to:

FileName = Split(Files(I), ".")(0)

As it came up with an error here (Compile Error).

After that it hit the following error at line:

QueryTables(1).Delete

Saying 'Compile Error: Sub or Function not defined' Not a clue on this one!

Thought it would be good to highlight the above before hopefully you manage to alter the code to read in the file names from 'Column A' of Sheet 'File_Names'.

Thanks Again!

Bump - Any Ideas

Hello R_S_6,

I have made the changes to the macro. Thanks for catching the typo. My typing skills are not very good. The file names are now read from the worksheet named "File_Names" column "A" starting with row 1 down to the last entry in the column.

Sub Import_dat_Modify_Export_csv()
'
'
' Macro to save *.dat files in *.csv format while removing the un-needed data at the top of the *.dat files
  '1
  
  Dim Cell As Range
  Dim FileName As String
  Dim Rng As Range
  Dim Wks As Worksheet
      
      
      Set Wks = Worksheets("File_Names")
      StartCell = "A1"
      
      With Wks
        C = .Range(StartCell).Column
        Set Rng = .Range(StartCell, .Cells(Rows.Count, C).End(xlUp))
      End With
     
        For Each Cell In Rng
          FileName = Split(Cell, ".")(0)
          With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;D:\TEMP\DIR\" & FileName _
            , Destination:=Range("A1"))
            .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 = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
          End With
          Rows("1:19").Select
          Selection.Delete Shift:=xlUp
          Range("A1").Select
          ChDir "D:\TEMP\X123"
          ActiveWorkbook.SaveAs FileName:= _
              "D:\TEMP\X123\" & FileName & ".csv" _
              , FileFormat:=xlCSV, CreateBackup:=False
          ActiveWindow.Close
          Workbooks.Add
          I = I + 1
        Next Cell
        
End Sub

Sincerely,
Leith Ross