csv-bestand importeren in excel met macro (VBA)

[kanhoman]

Ik wil graag een csv bestand importeren in een excel blad met behulp van een macro. Dit kan ik doen door het csv bestand te openen, te kopiëren en te plakken in excel -> zie macro 1. Hierbij kan ik zelf een csv-bestand kiezen. Ik krijg het echter niet voor elkaar om de lijstscheidingstekens goed te verwerken dus de tekst en getallen staan in één of twee kolommen. Met macro 2 kan ik het csv bestand wel goed verwerken maar dan krijg ik geen keuzescherm meer om zelf een csvbestand te kiezen. Hoe kan ik deze twee macro's combineren om het csv bestand te kunnen kiezen en goed te verwerken?

Sub Macro1()
'
' Macro1 Macro
'
Dim aw_name As String
Dim csv_bestand As Variant
aw_name = ActiveWorkbook.Name
csv_bestand = Application.GetOpenFilename("CSV Files (*.csv), .csv", , "Kies ..... CSV Bestand..... (CSV Bestand)")
Application.ScreenUpdating = False
Workbooks.Open csv_bestand
csv_bestand = ActiveWorkbook.Name
Workbooks(csv_bestand).Activate
Cells.Copy
Workbooks(aw_name).Activate
Sheets("Blad2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Workbooks(csv_bestand).Close 1
Workbooks(aw_name).Activate
Application.ScreenUpdating = True
Sheets("Blad1").Select
MsgBox "Het is klaar"

End Sub


Sub Macro2()
'
' Macro2 Macro
'
Dim aw_name As String
Dim csv_bestand As Variant
aw_name = ActiveWorkbook.Name
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;H:\_BEREKENINGEN\test.csv", _
Destination:=Range("A1"))
.Name = "test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Blad1").Select
End Sub

 

[snb]

Sub test()
  Workbooks.Open Application.GetOpenFilename
  ActiveSheet.Columns(1).TextToColumns [A1], , xlNone, , , , True
End Sub

 

[kanhoman]

ok, hiermee kan ik de tekst kopieren en plakken maar dan worden de lijstscheidingstekens (punt komma) niet verwerkt. Hierdoor komt alles in 1 of 2 kolommen.
Met macro 2 wordt de tekst geimporteerd maar dan kan ik geen bestand kiezen.
Hoe krijg ik dit dan in 1 macro?

 

[Balero]

Doe als externe gegevens importeren; deze procedure kun je meerdere keren aanroepen en dan worden de csv's in een blad gezet. Neem evt een macro op met Externe gegevens ophalen

Sub LeesCsvBestand(pCsvBestand As String, pStartRow As Integer)
'
Range("A65536").End(xlUp).Offset(1, 0).Select 'naar lege rij

' ActiveCell.Rows.Address geeft verwijzingstype A1

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & pCsvBestand, Destination:=Range(ActiveCell.Rows.Address))
.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 = pStartRow 'bij kopregels soms overslaan
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub