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