CSV DATEN PER VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: CSV DATEN PER VBA

09.07.2016 16:35:36

Matthias

AW: CSV DATEN PER VBA

09.07.2016 17:02:45

Susi

AW: CSV DATEN PER VBA

09.07.2016 20:54:50

Susi

AW: CSV DATEN PER VBA

09.07.2016 21:03:17

Peter

AW: CSV DATEN PER VBA

09.07.2016 21:44:54

Susi

AW: CSV DATEN PER VBA

09.07.2016 22:30:32

Matthias

AW: CSV DATEN PER VBA

10.07.2016 05:29:26

Susi

AW: CSV DATEN PER VBA

10.07.2016 09:04:04

Peter

AW: CSV DATEN PER VBA

10.07.2016 10:02:58

Susi

AW: CSV DATEN PER VBA

10.07.2016 10:36:28

Peter

AW: CSV DATEN PER VBA

10.07.2016 11:40:40

Susi

Respekt

10.07.2016 12:15:55

MB12

AW: Respekt

10.07.2016 12:35:39

Susi

AW: Respekt

10.07.2016 12:36:07

Susi

AW: Respekt

10.07.2016 12:36:12

Susi

CSV-Dateien

10.07.2016 12:43:58

Peter

kein problem Peter. Danke

10.07.2016 13:51:33

Susi

CSV-Dateien

10.07.2016 16:37:13

Peter

Testdateien CSW

10.07.2016 18:39:54

Peter

AW: CSV DATEN PER VBA

10.07.2016 14:04:18

Matthias

10.07.2016 16:33:11

Susi

AW: Matthias

10.07.2016 19:09:18

Matthias

Dankeschön

10.07.2016 19:58:21

Susi

Frage an Matthias

11.07.2016 07:39:59

Susi

Frage an Matthias

11.07.2016 07:40:00

Susi

AW: Frage an Matthias

11.07.2016 09:47:07

Susi

AW: Frage an Matthias

11.07.2016 12:39:02

Matthias

AW: Frage an Matthias

11.07.2016 16:43:56

Susi

Datei anpassen

11.07.2016 17:14:28

Peter

AW: Datei anpassen

11.07.2016 19:58:05

Susi

AW: Datei anpassen

11.07.2016 20:20:07

Peter

AW: Datei anpassen

11.07.2016 20:05:43

Matthias

AW: Datei anpassen

11.07.2016 20:41:16

Susi

AW: Datei anpassen

11.07.2016 21:27:59

Peter

AW: Frage an Matthias

11.07.2016 20:08:20

Matthias

Matthias und Peter

12.07.2016 19:20:41

Susi

Matthias und Peter

12.07.2016 21:30:07

Susi

Hallo Susi,
bitte richte zunächst mal die folgenden Pfade (Ordner) unter Laufwerk "C:\" ein:
C:\Reklamation
darunter die 3 Pfade (Ordner)
C:\Reklamation\Reklamation_CSV
C:\Reklamation\Reklamation_erl
C:\Reklamation\Reklamation_Excel
In den Pfad "C:\Reklamation\Reklamation_CSV" speichere bitte Deine zu bearbeitende CSV-Dateien ab. Der Pfad "C:\Reklamation\Reklamation_erl" nimmt bei Durchführung des Makros die erledigte CSV-Datei auf. Unter den Pfad "C:\Reklamation\Reklamation_Excel" ist die hier beigefügte Datei
https://www.herber.de/bbs/user/106888.xlsm
einzufügen. Bitte speichere diese Datei mit dem Namen "RGBGMBH.xlsm". In das gelbe Feld bitte den Namen der ersten zu bearbeitenden CSV-Datei eingeben (z. B. "reb1") und anschließend den Makro-Button drücken. Die CSV-Datei wird zunächst übernommen in den Pfad "...\Reklamation_Excel", dort in eine TXT-Datei umgewandelt (indem einfach die Endung geändert wird in ".TXT"). Anschließend wird das TXT-File in Excel geladen und der Inhalt in die Datei "RGBGMBH.xlsm" eingefügt. Danach wird noch das CSV-File aus der "...\Reklamation_CSV" in "...\Reklamation_erl" übertragen. In den Pfaden "...\Reklamation_CSV" und "...\Reklamation_Excel" werden die dort noch befindlichen CSV- bzw. TXT-Files gelöscht.
Es geht also nicht ganz so vollautomatisch wie von Dir gewünscht. D. h., es ginge schon, aber nicht von hier aus, sondern nur vor Ort. Hierzu müßte der Pfad mit den CSV-Files ausgelesen werden und nach und nach CSV-Datei für CSV-Datei mit diesem Programm bearbeitet werden.
Bitte mal ausprobieren, FeedBack wäre schön.
Mit freundlichem Gruß
Peter Kloßek

Sub Makro1() Datname1 = Range("Tabelle1!f1") Datname2 = Range("Tabelle1!f2") Datname3 = Range("Tabelle1!f3") Datname4 = Range("Tabelle1!f4") textdat = Range("Tabelle1!d4") Ansetz = Range("Tabelle1!m2") FileCopy (Datname1), (Datname2) Name (Datname2) As (Datname3) Workbooks.OpenText (Datname3), _ Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=True, 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)), TrailingMinusNumbers:=True Columns("C:C").Select Selection.NumberFormat = "0" Columns("D:D").Select Selection.NumberFormat = "0" Range("B2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("RGBGMBH.xlsm").Activate ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal Range(Ansetz).Select ActiveSheet.Paste Application.CutCopyMode = xlCopy FileCopy (Datname1), (Datname4) Kill (Datname1) Windows(textdat).Activate Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Kill (Datname3) End Sub

Hallo Susi, Hallo Peter!
Danke für den Code. Da Peter aber eh schon am Arbeiten ist, will ich ihm da nicht in seinem Code rumwerkeln. Hier mal noch eine Variante, mit der die Dateien automatisch geöffnet und ausgelesen werden. Vllt. kann es Peter ja mit gebrauchen. Die Pfade sind dabei so wie bei dir am Anfang mal erwähnt - könnten aber im Code auch geändert werden. In der Datei wird das Datum + Zeit vom kopieren mit eingetragen. Lediglich beim Abspeichern wird das Format der Zeit geändert, da im Dateinamen keine : sein dürfen. Habe die : deshalb durch einen . ersetzt. Der Code müsste lediglich einer Schaltfläche zugeordnet werden.
Euch noch einen schönen Sonntag , Kopf hoch und immer positiv denken!
VG Matthias

Option Explicit
Sub csv_importieren()
Dim ablagepfad As String
Dim dateiname As String
Dim pfaderledigt As String
Dim zieldatei As Object
Dim quelle As Object
Dim letztezeile As Long
Dim zeilequelle
Application.ScreenUpdating = False
'die Zieldatei, da wo das Makro ausgeführt wird
Set zieldatei = ThisWorkbook
'Zeile in die eingetragen wird
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'pfad für die Ausgangs CSV Dateien
ablagepfad = "C:\Reklamation\csv"
If Right(ablagepfad, 1)  "\" Then ablagepfad = ablagepfad & "\"
'C:\Reklamation\CSV\
'pfad wohin abgelegt werden soll, also die erledigten
pfaderledigt = "C:\Reklamation\erl"
If Right(pfaderledigt, 1)  "\" Then pfaderledigt = pfaderledigt & "\"
'C:\Reklamation\erl
'erste Datei suchen
dateiname = Dir(ablagepfad & "*.csv")
'wenn keine Datei gefunden, Meldung und Abbruch
If dateiname = "" Then
MsgBox "Keinen DATEN vorhanden.", , "Fehler bei Suche"
End
End If
'falls gefunden, alle durchgehen
Do Until dateiname = ""
'Dateien öffnen
Workbooks.Open ablagepfad & dateiname
Set quelle = ActiveWorkbook
'in Spaltenaufteilen
ActiveSheet.Columns(1).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, 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)), TrailingMinusNumbers:=True
'Anzahl der einzutragendenzeilen ermitteln
zeilequelle = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
'Daten kopieren
quelle.Worksheets(1).Range(quelle.Worksheets(1).Cells(2, 1), _
quelle.Worksheets(1).Cells(zeilequelle, 9)).Copy zieldatei.Worksheets(1) _
.Cells(letztezeile, 1)
'Datum und Zeit des Übertrages rein
zieldatei.Worksheets(1).Cells(letztezeile, 11) = Now
'Zeile für nächsten Eintrag neu setzen
letztezeile = letztezeile + zeilequelle - 1
'csv schließen
quelle.Close savechanges:=False
'CSV umbenennen und verschieben
Name ablagepfad & dateiname As pfaderledigt & Left(dateiname, Len(dateiname) - 4) _
& " " & Replace(Now, ":", ":") & ".csv"
'nächste CSV suchen
dateiname = Dir
Loop
'Formate noch anpassen, Spaltenbreite an Text anpassen + Format auf Zahl für Spalte B C
zieldatei.Worksheets(1).Columns("A:K").AutoFit
zieldatei.Worksheets(1).Columns("B:C").NumberFormat = "0"
Set zieldatei = Nothing
Set quelle = Nothing
Application.ScreenUpdating = True
End Sub

Sub csv_importieren() Dim ablagepfad As String Dim dateiname As String Dim pfaderledigt As String Dim zieldatei As Object Dim quelle As Object Dim letztezeile As Long Dim zeilequelle Application.ScreenUpdating = False 'die Zieldatei, da wo das Makro ausgeführt wird Set zieldatei = ThisWorkbook 'Zeile in die eingetragen wird letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'pfad für die Ausgangs CSV Dateien ablagepfad = "C:\Reklamation\Reklamation_CSV" If Right(ablagepfad, 1) "\" Then ablagepfad = ablagepfad & "\" 'C:\Reklamation\CSV\ 'pfad wohin abgelegt werden soll, also die erledigten pfaderledigt = "C:\Reklamation\Reklamation_erl" If Right(pfaderledigt, 1) "\" Then pfaderledigt = pfaderledigt & "\" 'C:\Reklamation\erl 'erste Datei suchen dateiname = Dir(ablagepfad & "*.csv") 'wenn keine Datei gefunden, Meldung und Abbruch If dateiname = "" Then MsgBox "Keinen DATEN vorhanden.", , "Fehler bei Suche" End End If 'falls gefunden, alle durchgehen Do Until dateiname = "" 'Dateien öffnen Workbooks.Open ablagepfad & dateiname Set quelle = ActiveWorkbook 'in Spaltenaufteilen ActiveSheet.Columns(1).Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, 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)), TrailingMinusNumbers:=True 'Anzahl der einzutragendenzeilen ermitteln zeilequelle = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Daten kopieren quelle.Worksheets(1).Range(quelle.Worksheets(1).Cells(2, 1), _ quelle.Worksheets(1).Cells(zeilequelle, 9)).Copy zieldatei.Worksheets(1) _ .Cells(letztezeile, 1) 'Datum und Zeit des Übertrages rein zieldatei.Worksheets(1).Cells(letztezeile, 11) = Now 'Zeile für nächsten Eintrag neu setzen letztezeile = letztezeile + zeilequelle - 1 'csv schließen quelle.Close savechanges:=False 'CSV umbenennen und verschieben Name ablagepfad & dateiname As pfaderledigt & Left(dateiname, Len(dateiname) - 4) _ & " " & Replace(Now, ":", ":") & ".csv" 'nächste CSV suchen dateiname = Dir Loop 'Formate noch anpassen, Spaltenbreite an Text anpassen + Format auf Zahl für Spalte B C zieldatei.Worksheets(1).Columns("A:K").AutoFit zieldatei.Worksheets(1).Columns("B:C").NumberFormat = "0" Set zieldatei = Nothing Set quelle = Nothing Application.ScreenUpdating = True End Sub

Option Explicit Sub csv_importieren() Dim ablagepfad As String Dim dateiname As String Dim pfaderledigt As String Dim zieldatei As Object Dim quelle As Object Dim letztezeile As Long Dim zeilequelle Application.ScreenUpdating = False 'die Zieldatei, da wo das Makro ausgeführt wird Set zieldatei = ThisWorkbook 'Zeile in die eingetragen wird letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'pfad für die Ausgangs CSV Dateien ablagepfad = "C:\Reklamation\csv" If Right(ablagepfad, 1) "\" Then ablagepfad = ablagepfad & "\" 'C:\Reklamation\CSV\ 'pfad wohin abgelegt werden soll, also die erledigten pfaderledigt = "C:\Reklamation\erl" If Right(pfaderledigt, 1) "\" Then pfaderledigt = pfaderledigt & "\" 'C:\Reklamation\erl 'erste Datei suchen dateiname = Dir(ablagepfad & "*.csv") 'wenn keine Datei gefunden, Meldung und Abbruch If dateiname = "" Then MsgBox "Keinen DATEN vorhanden.", , "Fehler bei Suche" End End If 'falls gefunden, alle durchgehen Do Until dateiname = "" 'Dateien öffnen Workbooks.Open ablagepfad & dateiname Set quelle = ActiveWorkbook 'in Spaltenaufteilen ActiveSheet.Columns(1).Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, 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)), TrailingMinusNumbers:=True 'Anzahl der einzutragendenzeilen ermitteln zeilequelle = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Daten kopieren quelle.Worksheets(1).Range(quelle.Worksheets(1).Cells(2, 1), _ quelle.Worksheets(1).Cells(zeilequelle, 9)).Copy zieldatei.Worksheets(1) _ .Cells(letztezeile, 1) 'Datum und Zeit des Übertrages rein zieldatei.Worksheets(1).Cells(letztezeile, 11) = Now 'Zeile für nächsten Eintrag neu setzen letztezeile = letztezeile + zeilequelle - 1 'csv schließen quelle.Close savechanges:=False 'CSV umbenennen und verschieben Name ablagepfad & dateiname As pfaderledigt & Left(dateiname, Len(dateiname) - 4) _ & " " & Replace(Now, ":", ".") & ".csv" 'nächste CSV suchen dateiname = Dir Loop 'Formate noch anpassen, Spaltenbreite an Text anpassen + Format auf Zahl für Spalte B C zieldatei.Worksheets(1).Columns("A:K").AutoFit zieldatei.Worksheets(1).Columns("B:C").NumberFormat = "0" Set zieldatei = Nothing Set quelle = Nothing Application.ScreenUpdating = True End Sub

Option Explicit Sub csv_importieren() Dim ablagepfad As String Dim dateiname As String Dim pfaderledigt As String Dim zieldatei As Object Dim quelle As Object Dim letztezeile As Long Dim zeilequelle Application.ScreenUpdating = False Application.DisplayAlerts = False 'die Zieldatei Set zieldatei = ThisWorkbook 'Zeile in die eingetragen wird letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 'pfad für die CSV Dateien ablagepfad = "C:\Reklamation\csv" 'C:\Reklamation\CSV\ If Right(ablagepfad, 1) "\" Then ablagepfad = ablagepfad & "\" 'pfad wohin abgelegt werden soll pfaderledigt = "C:\Reklamation\erl" If Right(pfaderledigt, 1) "\" Then pfaderledigt = pfaderledigt & "\" 'C:\Reklamation\erl 'erste Datei suchen dateiname = Dir(ablagepfad & "*.csv") 'wenn keine Datei gefunden, Meldung und Abbruch If dateiname = "" Then MsgBox "Keinen DATEN vorhanden.", , "Fehler bei Suche" End End If 'falls gefunden, alle durchgehen Do Until dateiname = "" 'Dateien öffnen Workbooks.Open ablagepfad & dateiname Set quelle = ActiveWorkbook 'in Spaltenaufteilen ActiveSheet.Columns(1).Select Selection.TextToColumns Destination:=ActiveSheet.Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, 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)), _ TrailingMinusNumbers:=True 'Anzahl der einzutragendenzeilen ermitteln zeilequelle = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Daten kopieren quelle.Worksheets(1).Range(quelle.Worksheets(1).Cells(2, 1), _ quelle.Worksheets(1).Cells(zeilequelle, 9)).Copy _ zieldatei.Worksheets(1).Cells(letztezeile, 1) 'Datum und Zeit des Übertrages rein zieldatei.Worksheets(1).Cells(letztezeile, 11) = Now 'Zeile für nächsten Eintrag neu setzen letztezeile = letztezeile + zeilequelle - 1 'csv schließen quelle.Close savechanges:=False 'CSV umbenennen und verschieben Name ablagepfad & dateiname As pfaderledigt & Left(dateiname, Len(dateiname) - 4) _ & " " & Replace(Now, ":", ".") & ".csv" 'nächste CSV suchen dateiname = Dir Loop 'Formate noch anpassen, Spaltenbreite an Text anpassen und Format auf Zahl für Spalte B und C zieldatei.Worksheets(1).Columns("A:K").AutoFit zieldatei.Worksheets(1).Columns("B:C").NumberFormat = "0" Set zieldatei = Nothing Set quelle = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

37 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

37
Beiträge zum Forumthread

Beiträge zu diesem Forumthread