text bestand importeren in excel

[popipipo]

http://office.webforums.nl/forum/viewtopic.php?t=29530

In bovenstaande forum heb ik een vraag gesteld en kreeg geen duidelijk antwoord.
Daarom probeer ik het hier nogmaals.

Ik heb een excel bestand geopend daar in wil ik een text bestand importeren, waarna er diverse berekeningen op uitgevoerd moeten worden. De berekeningen zijn niet het probleem.
Het lukt me ook wel om een bestand te importeren met een vaste naam.
Het lukt me ook om een bestand te kiezen uit een directory en dit in een nieuw excel bestand te openen.

Ik wil echter een bestand uit een directory kiezen en dit importeren in het bestand dat ik open heb en waar aan de berekeningen vast zitten.
bijgaand het excel bestand en enkele txt bestanden.

 

[Wigi]

Voilà

Sub GetOpenFileNameExample3()
    
    Dim vFilename As Variant
    Dim sPath As String
    Dim lFilecount As Long
    Dim lCount As Long
    
    sPath = "C:\"
    ChDrive sPath
    ChDir sPath
    
    vFilename = Application.GetOpenFilename("text files (*.txt),*.txt", , "Please select the file(s) to import", , True)
    
    If TypeName(vFilename) = "Boolean" Then Exit Sub
    
    For lCount = LBound(vFilename) To UBound(vFilename)
    
        Workbooks.OpenText Filename:=vFilename(lCount), Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, FieldInfo:=Array(1, 1), _
            TrailingMinusNumbers:=True
            
        With ActiveWorkbook.Sheets(1)
            
            Application.DisplayAlerts = False
            .Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.DisplayAlerts = True
            
        End With
    
    Next
    
End Sub

Wigi

 

[popipipo]

Ok Wigi het werkt natuurlijk, maar......

Ik had de vraag nog iets duidelijker moeten stellen.
Het bestand moet nl niet in een nieuw werkblad geopend worden maar in het geopende werkblad beginnend in cel A1
En als ik nog een bestand wil openen moet deze onder het eerste bestand staan.
Dit kan denk ik oplopen tot ca 10 bestanden.
Dit alles ivm de berekeningen die daarna gedaan moeten worden.

 

[Wigi]

Dan moet je achteraf nog de cellen knippen, met .Cut kan dat. En dan moet je ook het tabblad niet meer knippen, ik schreef dat omdat de vraag te onduidelijk was.

 

[Wigi]

Alternatief is iets van deze pagina:

http://www.cpearson.com/excel/ImpText.aspx

Onnodig te zeggen dat dat het er niet makkelijker op maakt...

Wigi

 

[popipipo]

Via het andere forum heb ik deze oplossing gevonden.

Sub GetOpenFileNameExample5()
  sPath = "D:\test\"
  st = Application.GetOpenFilename("text files (*.txt),*.txt", , "Bestandsselectie", , True)
  If TypeName(st) = "Boolean" Then Exit Sub
  
  'voor een file:
  'With ActiveSheet.QueryTables.Add("TEXT;" & st(1), Range("A1"))
  
  'voor meerdere files onderelkaar:
   With ActiveSheet.QueryTables.Add("TEXT;" & st(1), Range("A" & Rows.Count).End(xlUp).Offset(2))
    
    .Name = st(1)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlMSDOS
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = True
    .Refresh BackgroundQuery:=False
  End With
End Sub