Keskustelu: Ohjelmointikysymykset: VBA: .csv tiedostojen yhdistäminen Exceliin

Sub SuoritaKaannos()

 Dim basebook As Excel.Workbook
 Dim mybook As Excel.Workbook
 Dim sourceRange As Range
 Dim destrange As Range
 Dim FNames As String
 Dim MyPath As String
 Dim SaveDriveDir As String
 SaveDriveDir = CurDir
 MyPath = ("C:\temppi")
 If MyPath = "" Then Exit Sub
 ChDrive MyPath
 ChDir MyPath
 FNames = Dir("*.csv")
 If Len(FNames) = 0 Then
  MsgBox "No files in the Directory"
  ChDrive SaveDriveDir
  ChDir SaveDriveDir
  Exit Sub
 End If
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Application.AskToUpdateLinks = False

 Set basebook = ThisWorkbook 'Ei suostu toimimaan

 Do While FNames <> ""
  Set mybook = Workbooks.Open(FNames)
  Columns("A:A").Select

   Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
   TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
   Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
   :="$", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
   1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1))

  ActiveSheet.Move after:=Workbooks("master.xls").Sheets(Workbooks("master.xls").Sheets.Count)
  On Error Resume Next
  On Error GoTo 0
   ' mybook.Close True
  FNames = Dir()
 Loop
 ChDrive SaveDriveDir
 ChDir SaveDriveDir
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
 Application.AskToUpdateLinks = True
End Sub