'-------------
Sub ImportTxt()
'-------------
Dim vFile
Dim sCell As String
Const kStartDIR = "c:\temp\"
If MsgBox("Is the cursor on the cell to import the data to?", vbYesNo + vbQuestion, "Confirm") = vbNo Then Exit Sub
sCell = ActiveCell.Address
vFile = UserPick1File(kStartDIR)
If vFile <> "" Then
Import1Txt vFile, sCell
End If
End Sub
'-------------
Private Function UserPick1File(pvPath)
'-------------
Dim strTable As String
Dim strFilePath As String
Dim sDialogMsg As String, sDecr As String, sExt As String
Const msoFileDialogFilePicker = 3
'CONST msoFileDialogViewList = 1
With Application.FileDialog(msoFileDialogFilePicker) 'MUST ADD REFERENCE : Microsoft Office 11.0 Object Library
.AllowMultiSelect = True
.Title = sDialogMsg ' "Locate a file to Import"
.ButtonName = "Import"
.Filters.Clear
.Filters.Add "Text Files", "*.txt;*.txt"
.Filters.Add "CSV Files", "*.csv;*.csv"
'.Filters.Add "Access Files", "*.accdb;*.mdb"
'.Filters.Add "Excel Files", "*.xlsx"
.Filters.Add "All Files", "*.*"
.InitialFileName = pvPath
.InitialView = msoFileDialogViewList 'msoFileDialogViewThumbnail
If .Show = 0 Then
'There is a problem
Exit Function
End If
'Save the first file selected
UserPick1File = Trim(.SelectedItems(1))
End With
End Function
Private Sub Import1Txt(pvFile2Import, pvCell)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & pvFile2Import, Destination:=Range(pvCell))
'.CommandType = 0
.Name = "File2Load"
.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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub