Option Explicit
Sub ImportDir()
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String
Dim Folder As String
Set wb = ThisWorkbook
'Get the Directory Path
Folder = GetFolder
'Get the first file that matches the *DAT criteria
FileName = Dir(Folder & "\*.Dat")
Do While Len(FileName) > 0
Debug.Print FileName
wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.ActiveSheet
'Import the CSV File
ImportCSV FileName, ws
'Get the next file in the directory
FileName = Dir
Loop
End Sub
Function GetFolder() As String
'Locate the Folder Name
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
'.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
End Function
Function ImportCSV(ByVal FileName As String, ws As Worksheet)
Debug.Print "******" & FileName
With ws.QueryTables.Add(Connection:= _
"TEXT;" & FileName, Destination:=Range("A$1"))
.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 = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Function
Sub Macro3()
'
' Macro3 Macro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\cpelab\Desktop\new 2.dat", Destination:= _
Range("$A$1"))
.Name = "new 2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
