Nachfolgend die Möglichkeit per...
02.03.2024 10:25:07
Case
Moin, :-)
... VBA - ohne Verbindung nur mit Workbooks.Open. ;-)
Prinzipiell ist es nur ein Einzeiler:
' Variablendeklaration erforderlich!
' https://learn.microsoft.com/de-de/office/vba/language/reference/user-interface-help/option-explicit-statement
Option Explicit
' Pfad- und Dateiname anpassen!!!
Const strPathFile As String = "C:\TMP\Test.csv"
Public Sub Main_1()
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
End Sub
Das nur zum Anfang. Passe den Pfad- und Dateinamen an und schaue, ob du damit leben kannst. Wenn ja kommt Schritt 2: ;-)
Public Sub Main_2()
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
' Mit ActiveSheet können wir arbeiten, da eine mit Open geöffnete Datei - IN DER REGEL - immer die aktuelle ist.
' ActiveSheet.Copy erstellt eine neue Datei - und auch diese ist wieder - IN DER REGEL - die aktuelle Datei.
' Es wird eine neue Mappe mit dem einzigen Sheet der CSV-Datei erstellt.
ActiveSheet.Copy
' Die Zeilen 1 bis 16 werden gelöscht.
Rows("1:16").Delete
' Die Ursprungsdatei wird geschlossen. Da Workbooks.Close nur den Dateinamen ohne Pfad erwartet kürze ich hier mit Mid und InStRev.
Workbooks(Mid$(strPathFile, InStrRev(strPathFile, "\") + 1)).Close False
End Sub
Hier hast du die Daten jetzt in einem neuen Tabellenblatt. Wenn das halbwegs brauchbar ist kommen wir zu Schritt 3: ;-)
Public Sub Main_3()
' Variablendeklaration
Dim wksSheet As Worksheet
Dim strFile As String
' Wenn ein Fehler auftritt gehe zur angegebenen Sprungmarke
On Error GoTo Fin:
' Der Datei-Öffnen-Dialog eingeschränkt auf CSV-Dateien und ohne Mehrfachauswahl von Dateien.
strFile = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv", , "CSV Filter", , False)
' Wenn NICHT Abbrechen geklickt wurde dann...
If strFile > "Falsch" Then
' Bildschirmaktualisierung aussschalten.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.screenupdating
Application.ScreenUpdating = False
' Fehlermeldungen unterdrücken bzw. die Standardantwort wird automatisch gegeben.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.displayalerts
Application.DisplayAlerts = False
' Schleife über alle Tabellenblätter der Datei mit diesem Code.
For Each wksSheet In ThisWorkbook.Worksheets
' Ist der Tabellenblattname "Protokoll" dann lösche dieses Tabellenblatt.
If wksSheet.Name = "Protokoll" Then wksSheet.Delete
Next wksSheet
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
' Das erste - und bei einer CSV-Datei einzige - Tabellenblatt wird in die Datei mit diesem Makro an die erste Position verschoben.
' !!!!! Ein Workbooks.Close ist hier nicht erforderlich, da ich das einzige Tabellenblatt verschiebe.
' !!!!! Eine Mappe ohne Tabellenblatt geht nicht. Die Datei wird automatisch geschlossen.
Workbooks(Mid$(strFile, InStrRev(strFile, "\") + 1)).Worksheets(1).Move Before:=ThisWorkbook.Worksheets(1)
' Und erhält den Namen "Protokoll".
ThisWorkbook.Worksheets(1).Name = "Protokoll"
' Die Zeilen 1 bis 16 werden gelöscht.
ThisWorkbook.Worksheets(1).Rows("1:16").Delete
End If
Fin:
' Bildschirmaktualisierung einschalten.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.screenupdating
Application.ScreenUpdating = True
' Fehlermeldungen wieder aktivieren.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.displayalerts
Application.DisplayAlerts = True
' Wenn ein Fehler aufgetreten ist gib ihn mit Nummer und Beschreibung aus.
If Err.Number > 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub
Das sollte dem was du möchtest doch recht nahe kommen. ;-)
Der Code ist ausreichend kommentiert und mit nützlichen Links versehen. ;-)
Nicht alle Parameter die ich bei "Open" verwende sind notwendig. Schau dir dazu den Link an und setze die Parameter nach deinen Vorstellungen bzw. Bedürfnissen.
Hier nochmal als Ganzes: ;-)
' Variablendeklaration erforderlich!
' https://learn.microsoft.com/de-de/office/vba/language/reference/user-interface-help/option-explicit-statement
Option Explicit
' Pfad- und Dateiname anpassen!!!
Const strPathFile As String = "C:\TMP\Test.csv"
Public Sub Main_1()
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
End Sub
Public Sub Main_2()
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
' Mit ActiveSheet können wir arbeiten, da eine mit Open geöffnete Datei - IN DER REGEL - immer die aktuelle ist.
' ActiveSheet.Copy erstellt eine neue Datei - und auch diese ist wieder - IN DER REGEL - die aktuelle Datei.
' Es wird eine neue Mappe mit dem einzigen Sheet der CSV-Datei erstellt.
ActiveSheet.Copy
' Die Zeilen 1 bis 16 werden gelöscht.
Rows("1:16").Delete
' Die Ursprungsdatei wird geschlossen. Da Workbooks.Close nur den Dateinamen ohne Pfad erwartet kürze ich hier mit Mid und InStRev.
Workbooks(Mid$(strPathFile, InStrRev(strPathFile, "\") + 1)).Close False
End Sub
Public Sub Main_3()
' Variablendeklaration
Dim wksSheet As Worksheet
Dim strFile As String
' Wenn ein Fehler auftritt gehe zur angegebenen Sprungmarke
On Error GoTo Fin:
' Der Datei-Öffnen-Dialog eingeschränkt auf CSV-Dateien und ohne Mehrfachauswahl von Dateien.
strFile = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv", , "CSV Filter", , False)
' Wenn NICHT Abbrechen geklickt wurde dann...
If strFile > "Falsch" Then
' Bildschirmaktualisierung aussschalten.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.screenupdating
Application.ScreenUpdating = False
' Fehlermeldungen unterdrücken bzw. die Standardantwort wird automatisch gegeben.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.displayalerts
Application.DisplayAlerts = False
' Schleife über alle Tabellenblätter der Datei mit diesem Code.
For Each wksSheet In ThisWorkbook.Worksheets
' Ist der Tabellenblattname "Protokoll" dann lösche dieses Tabellenblatt.
If wksSheet.Name = "Protokoll" Then wksSheet.Delete
Next wksSheet
' Erklärung der Parameter für Open - https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open
' Hier ist besonders der Parameter Local (Local:=True) interessant.
Workbooks.Open Filename:=strPathFile, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Origin:=xlMSDOS, Local:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile
' Das erste - und bei einer CSV-Datei einzige - Tabellenblatt wird in die Datei mit diesem Makro an die erste Position verschoben.
' !!!!! Ein Workbooks.Close ist hier nicht erforderlich, da ich das einzige Tabellenblatt verschiebe.
' !!!!! Eine Mappe ohne Tabellenblatt geht nicht. Die Datei wird automatisch geschlossen.
Workbooks(Mid$(strFile, InStrRev(strFile, "\") + 1)).Worksheets(1).Move Before:=ThisWorkbook.Worksheets(1)
' Und erhält den Namen "Protokoll".
ThisWorkbook.Worksheets(1).Name = "Protokoll"
' Die Zeilen 1 bis 16 werden gelöscht.
ThisWorkbook.Worksheets(1).Rows("1:16").Delete
End If
Fin:
' Bildschirmaktualisierung einschalten.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.screenupdating
Application.ScreenUpdating = True
' Fehlermeldungen wieder aktivieren.
' https://learn.microsoft.com/de-de/office/vba/api/excel.application.displayalerts
Application.DisplayAlerts = True
' Wenn ein Fehler aufgetreten ist gib ihn mit Nummer und Beschreibung aus.
If Err.Number > 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub