Importing a .TXT File using Macro?

[SendHalp3]

Hi!
I don't even know if this is possible but I'd like to see if I can import a .txt file into a excel workbook sheet using a Macro- just a pastevalues. Where you run the macro, a window pops up where you select the .txt file you want to import from your computer, and the macro pastes it in wherever specified.

Is this possible? And if so, what would the code be/look like? I've tried looking it up and I'm getting mixed results.


Thank you!

 

[ranman256]

paste the code into a module.
usage, run: ImportTxt

start with cursor in the cell to import to,
it will ask what file to import, user then picks it,
then it puts the data into the cell.

you may need to alter the sub: Import1Txt()
set ARRAY to your file.
(you can record a macro , import your file, stop recording , then view the array in that code.)

'-------------
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