Vielen lieben Dank für deine schnelle Hilfe. Ich versuche es nochmal mit den richtigen Bezeichnungen.
Ich möchte aus einem Ordner mit über 3000 csv Dateien, jeweils eine CSV Datei in eine vorhandende Excel Datei einlesen. Die ursprüngliche Excel Datei hat über 15 Arbeitsblätter in denen Berechnungen vorgenommen werden, basierend auf den Daten der importierten CSV Datei. Die CSV Datei soll in das Arbeitsblatt 'RawData' einglesen werden. Die Daten in der CSV Datei sind getrennt mit Semikolon Trennung.
Sobald alle Daten in das Arbeitsblatt 'RawData' import sind, soll die gesamte Excel Datei gespeichert werden. Der Name der neuen Datei ist in Zelle RawData A284 und RawData J284. Nach erfolgreich erstellter Excel Datei soll die CSV Datei aus dem Ornder gelöscht werden.
Ich habe versucht die Dir () Funktion für Mac anzupassen, bekomme aber immer noch einen Fehler. Um die Pfadangabe zu vereinfachen, habe ich die Original Datei in das Verzeichnis der CSV Dateien koppiert.
Option Explicit
Sub ImportCSVFiles()
Dim CSVFile As Variant
Dim wsRawData As Worksheet
Dim MyDir As String
Dim strPath As String
Dim strNewFileName As String
' Set the folder path
MyDir = ActiveWorkbook.Path
strPath = MyDir & ":"
' Check if the folder path exists and create it if it doesn't
If Len(Dir(strPath, MacID("TEXT"))) = 0 Then
MkDir strPath
End If
' Loop through all CSV files in the folder
CSVFile = Dir(strPath & "*.csv")
Do While Len(CSVFile) > 0
' Set the RawData worksheet
Set wsRawData = ThisWorkbook.Worksheets("RawData")
' Clear the RawData worksheet
wsRawData.Cells.ClearContents
' Import the CSV file into the RawData worksheet
On Error Resume Next
With wsRawData.QueryTables.Add(Connection:="TEXT;" & strPath & CSVFile, Destination:=wsRawData.Cells(1, 1))
If Err.Number <> 0 Then
MsgBox "Error importing CSV file: " & Err.Description, vbCritical, "Import Error"
Exit Sub
End If
.TextFileParseType = xlDelimited
.TextFileSemicolonDelimiter = True
.Refresh
End With
On Error GoTo 0
' Save the imported data as a new Excel file (.xlsx)
strNewFileName = Replace(wsRawData.Range("C284").Value & "_" & wsRawData.Range("J284").Value, ":", "") & ".xlsx"
ThisWorkbook.SaveCopyAs fileName:=strPath & strNewFileName
' Delete the used CSV file
Kill strPath & CSVFile
' Move on to the next CSV file
CSVFile = Dir
Loop
End Sub