Anzeige
Archiv - Navigation
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Import von CSV Datei in Arbeitsmappe

Import von CSV Datei in Arbeitsmappe
25.11.2017 22:11:16
CSV
Guten Tag,
ich habe im Internet schon viel gesucht aber nicht wirklich was gefunden.
Ich möchte gerne eine CSV Datei importieren.
Ich habe aber das Problem das die CSV Datei mit diesem Code:
Sub einlesen()
Z = Sheets(1).UsedRange.Rows.Count
Open "C:\Users\Desktop\dateixyz.csv" For Input As #1
Do While Not EOF(1)
Line Input #1, temp
Sheets(1).Cells(Z, 1) = Replace(temp, vbTab, ";")
Z = Z + 1
Loop
Close #1
For j = 1 To Z
    Text = Split(Cells(j, 1), ";")
        For i = 0 To UBound(Text)
            Cells(j, i + 1) = Text(i)
        Next
    Next
End Sub

zwar eingelesen wird aber alles nur in einer Zeile dargestellt wird und dort wo die nächste Zeile anfängt schreibt er mir in eine Zeile:
und das sieht dann so aus:
Typ
1     
aber wie gesagt in einer Zelle.
Gibt es einen Befehlt um in der nächsten Zeile bei Alt+Enter anzufangen ?
Ach ja und noch eine Entdeckung die ich gemacht habe ist:
wenn ich es mit dem Makrorekorder aufzeichne schiebt er die Daten in die richtigen spalten und zeilen.
Leider kann ich den Rekorder nicht nutzen da er eine Datenverbindung erstellt die ich dann nicht gebrauchen kann.
 

53
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Import von CSV Datei in Arbeitsmappe
25.11.2017 22:17:02
CSV
Hallo ?,
wie sieht den so eine csv aus?
Gruß Sepp

AW: Import von CSV Datei in Arbeitsmappe
25.11.2017 22:20:58
CSV
Ich kann diese leider hier nicht hochladen, da csv als Format zum upload nicht erlaubt wird.
Soll / kann ich dir diese per mail zusenden?
zippen! o.T.
25.11.2017 22:21:39
Sepp
Gruß Sepp

AW: zippen! o.T.
25.11.2017 22:40:39
GP123
Hier ist die Datei:
https://www.herber.de/bbs/user/117915.zip
Mappe1 ist die Zieldatei
und die Andere die Quelldatei
Anzeige
AW: zippen! o.T.
26.11.2017 12:25:34
GP123
Vielen Dank.
Kannst du mir dazu etwas erklären?
Ich möchte das gerne verstehen.
Soll ich gezielt die Passagen erfragen die ich nicht kenne/verstehe?
AW: zippen! o.T.
26.11.2017 12:33:37
Sepp
Hallo Anne,
der erste Teil dient der Dateiauswahl und sollte soweit verständlich sein.
Die Daten werden dann per ADO (Microsoft ActiveX Data Objects) mittels SQL-Abfrage aus der Textdatei eingelesen. Die Funktion 'MakeSchemaINI()' erstellt dazu eine Textdatei 'Schema.ini' die die entsprechenden Parameter für den Import vorgibt. Wenn die Abfrage erfolgreich ist, werden die Überschriften in die erste Zeile der Tabelle geschrieben und die Daten mit '.CopyFromRecordset' in die Tabelle kopiert.
Bei weiteren Fragen einfach 'fragen' ;-)
Gruß Sepp

Anzeige
AW: zippen! o.T.
26.11.2017 14:29:17
GP123
Ist das die einzige Möglichkeit oder würde es auch "einfacher" gehen?
Also ich meine ohne eine neue Datei zu erstellen und einfach die vorhandene einlesen so wie ich es auch mit dem manuellen Import machen würde nur halt ohne eine Datenverbindung zu erstellen?
AW: zippen! o.T.
26.11.2017 15:24:03
Sepp
Hallo Anne,
und was stört dich an meinem Code? Die Datei die erstellt wird, hat nichts mit der Textdatei zu tun, in der deine Daten stehen, die ist nur ein paar Zeilen lang.
Gruß Sepp

AW: zippen! o.T.
26.11.2017 15:24:20
Sepp
Hallo Anne,
und was stört dich an meinem Code? Die Datei die erstellt wird, hat nichts mit der Textdatei zu tun, in der deine Daten stehen, die ist nur ein paar Zeilen lang.
Gruß Sepp

Anzeige
AW: zippen! o.T.
26.11.2017 16:03:22
GP123
Hey Sorry,
nicht falsch verstehen. Stören tut mich daran garnichts.
Ich stelle mir nur folgende Fragen:
1. Kann ich das Makro auch ausführen wenn ich nur leserechte habe in dem Ordner wo die CSV liegt.
2. Ich wollte gerne das Makro noch erweitern aber ohne ständig zu fragen wie und wo was funktioniert.
Bsp: Wenn es von den CSV dateien mehrere gibt z.B. 10 Stück und ich anhand von einer bestimmten Zelle in der CSV prüfen will was dort steht um damit im nachhinein alle 10 csv in verschiedene blätter zu laden, bin ich aufgeschmissen wenn ich das nicht verstehe.
Oder soll ich so ein Beispiel mal hochladen?
Anzeige
AW: zippen! o.T.
26.11.2017 16:08:27
Sepp
Hallo Anne,
leserechte sollten genügen.
Per sql kann man auch nur bestimmte Salten importieren, oder nur Daten die in einer oder mehrerer Spalten einen bestimmten Wert haben. Gib mal ein konkretes Beispiel, was du überprüfen willst und was dann importiert werden soll.
Sollen die Daten in bestehende Blätter importiert werden, oder sollen die Blätter beim Import erstellt werden?
Gruß Sepp

AW: zippen! o.T.
26.11.2017 16:50:58
GP123
Ok also es gibt 4 CSV Dateien in dem Beispiel.
Alle haben einen anderen Namen.
In der Zieldatei gibt es 3 Blätter die nach dem Wert in Spalte 2 der CSV benannt sind aber auch anders benannt werden können also sollten wir uns nicht auf den Namen beziehen sondern auf das Blatt um bei Änderungen ggf. nur den Blattname ändern zu müssen. (ich meine damit wir können nicht den Eintrag in Spalte 2 der CSV mit dem Namen im Zielblatt vergleichen)
In der CSV kann nur in Spalte 2 der einzelne Wert stehen, also eine Vermischung kann dort nicht stattfinden. Dort steht immer das gleiche.
Nun soll bei Auswahl der CSV Dateien der FP 123 in das Blatt import123 und der FP 234 in das Blatt import234 und auch der FP 345 in das Blatt import345.
Wenn das erfolgt ist gibt es noch ein Problem.
Es kann vorkommen das versehentlich 2x der gleiche import gewählt wurde wie bei csv 3456789 und der 4567891.
Das wäre schlecht. Ich will dann gerne eine Meldung haben das hier 2x der gleiche Datensatz kopiert wird und das soll nicht erfolgen. Im Anschluss sollte er mit der Nächsten csv weitermachen.
Anzeige
AW: zippen! o.T.
26.11.2017 18:26:18
GP123
Die Datei funktioniert perfekt.
Nur habe ich mich mal wieder falsch ausgedrückt bzw was vergessen.
Er soll nicht generell die 2. Datei in dem gleichen Tabellenblatt nicht einlesen sondern nur wenn der bereits vorhandene Datensatz den gleichen Inhalt in der 2.Zeile hat (Also nicht Überschriften sondern die Zeile darunter mit den 1.Daten) wie der Datensatz der nun darunter einkopiert werden soll.
Anzeige
AW: zippen! o.T.
26.11.2017 18:35:57
Sepp
Hallo Anne,
zum Verständnis. Die zweite Datei soll nur dann eingelesen werden, wenn die Daten unterschiedlich sind? Welche Spalten sind relevant um den Unterschied festzustellen?
Gruß Sepp

AW: zippen! o.T.
26.11.2017 19:00:19
GP123
Genau so ist es wenn Spalten B/C/I identisch sind dann nicht einlesen und sonst unten anfügen.
Mir würden im Grunde auch zum Importieren die Spalten B/C/I ausreichen dann aber in die Zieldatei in A/B/C.
Würde jetzt die ganze Spalte geprüft werden?
Es reicht im Grunde genommen wenn nur die jeweilig 2. Zeile der Spalten geprüft werden.
Aber du hattest ja das es nicht ohne weiteres möglich ist nur Zeile 2 zu prüfen stimmts?
Anzeige
AW: zippen! o.T.
26.11.2017 19:32:41
Sepp
Hallo Anne,
doch, kein Problem nur die zweite Zeile zu Prüfen und auch nur die benötigten Spalten zu importieren.
Ersetze die Prozedur.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strPath = Mid(vntFiles(lngI), 1, InStrRev(vntFiles(lngI), "\"))
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [FP], [TAG], [MELDEZEIT] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(0)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (Clng(CDate(objRS.Fields(1)) + CDate(objRS.Fields(2))) <> Clng(.Cells(2, 2) + .Cells(2, 3))) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(2).NumberFormat = "DD.MM.YYYY"
                .Columns(3).NumberFormat = "HH:MM:SS"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
  Next
  
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub


Der Rest des Codes bleibt unverändert.
Gruß Sepp

Anzeige
AW: zippen! o.T.
26.11.2017 19:40:06
GP123
Super Klasse.
Kann ich jetzt noch eine Meldung generieren wenn er eine Datei nicht verwendet weil diese Bereits vorhanden ist?
AW: zippen! o.T.
26.11.2017 19:46:25
GP123
Ach Mensch. Spalte D benötige ich doch auch noch.
Und das soll er ja auch vergleichen ob gleich dem anderen Blatt... Sorry
AW: zippen! o.T.
26.11.2017 19:56:25
Sepp
Hallo Anne,
Spalte D währe dann 'PNR', oder?
Soll da auch nur die erste Zeile geprüft werden?
Wie meinst du das mit "eine Meldung generieren wenn er eine Datei nicht verwendet weil diese Bereits vorhanden ist"?
Woran erkennt man, dass eine Datei bereits importiert wurde?
Gruß Sepp

Anzeige
AW: zippen! o.T.
26.11.2017 20:18:39
GP123
Ja genau. PNR und diese soll auch geprüft werden.
Na ich meine wenn es jetzt 2x die Identische Datei gibt (wie im Beispiel) soll er Sie ja nicht nehmen da diese bereits vorhanden ist. Dann hätte ich gerne eine kurze Meldung das der Datensatz doppelt ist.
Deswegen vergleichen wir ja die Zeile 2 mit der nächsten Datei, die darunter einkopiert wird wenn der FP der gleiche ist und die Zeile 2 nicht mit der Zeile 2 der 2.CSV übereinstimmt.
AW: zippen! o.T.
26.11.2017 20:31:20
Sepp
Hallo Anne,
Rest bleibt wie gehabt.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strPath = Mid(vntFiles(lngI), 1, InStrRev(vntFiles(lngI), "\"))
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [FP], [TAG], [MELDEZEIT], [PNR] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(0)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (Clng(CDate(objRS.Fields(1)) + CDate(objRS.Fields(2))) <> Clng(.Cells(2, 2) + .Cells(2, 3))) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(2).NumberFormat = "DD.MM.YYYY"
                .Columns(3).NumberFormat = "HH:MM:SS"
              Else
                MsgBox "Doppelte Daten für 'FP " & strSheet & "'!" & vbLf & _
                  "Datei '" & strFile & "' wird übersprungen!"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
  Next
  
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub

Gruß Sepp

AW: zippen! o.T.
26.11.2017 20:46:22
GP123
Super.
Genau so meinte ich das.
Nur hab ich das Problem das er auch wenn die PNR in der 2. csv datei geändert wird er mir sagt das die Datei doppelt ist.
Ist Sie ja aber nicht. Es ist ja eine andere PNR in der 2.Zeile der 1. und 2.CSV Datei.
Er müsste eigentich dann die 2. CSV unter der 1.CSV einfügen im Blatt FP 234 oder?
AW: zippen! o.T.
26.11.2017 21:05:18
Sepp
Hallo Anne,
geprüft werden nur TAG und MELDUNGSZEIT, wenn die beiden identisch sind, so ist es doch wohl die selbe Meldung. Ich kann aber die Prüfung auch auf die PNR ausweiten, wenn gewünscht.
Gruß Sepp

AW: zippen! o.T.
26.11.2017 21:26:41
GP123
Das wäre super.
Und wichtig wäre das nur falsch wenn alles stimmt. Also Tag Meldungszeit und PNR.
Hier geht's weiter!
26.11.2017 21:38:18
Sepp
Hallo Anne,
dann teste mal.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strPath = Mid(vntFiles(lngI), 1, InStrRev(vntFiles(lngI), "\"))
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [FP], [TAG], [MELDEZEIT], [PNR] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(0)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (CDbl(CDate(objRS.Fields(1)) + CDate(objRS.Fields(2))) <> (CDbl(.Cells(2, 2) + .Cells(2, 3)))) Or (objRS.Fields(3) <> .Cells(2, 4)) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(2).NumberFormat = "DD.MM.YYYY"
                .Columns(3).NumberFormat = "HH:MM:SS"
              Else
                MsgBox "Doppelte Daten für 'FP " & strSheet & "'!" & vbLf & _
                  "Datei '" & strFile & "' wird übersprungen!"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
  Next
  
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub


Gruß Sepp

AW: Hier geht's weiter!
26.11.2017 21:52:11
GP123
Super. Ich bin Dir echt Dankbar.
Eine letzte Frage habe ich aber noch.
An welcher Stelle fügst du die Spalten in das Zielblatt ein?
Ich frage weil ich evtl. die PNR vorne anstellen will.
AW: Hier geht's weiter!
26.11.2017 22:01:38
GP123
Super. Ich bin Dir echt Dankbar.
Eine letzte Frage habe ich aber noch.
An welcher Stelle fügst du die Spalten in das Zielblatt ein?
Ich frage weil ich evtl. die PNR vorne anstellen will.
AW: Hier geht's weiter!
26.11.2017 22:24:10
Sepp
Hallo Anne,
die Reihenfolge der Spalten stellt man hier ein.
strSQL = "SELECT [PNR], [FP], [TAG], [MELDEZEIT] From [" & strFile & "]"
Allerdings muss man auch im weiteren Code die Spalten zur Überprüfung anpassen.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strPath = Mid(vntFiles(lngI), 1, InStrRev(vntFiles(lngI), "\"))
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [PNR], [FP], [TAG], [MELDEZEIT] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(1)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (CDbl(CDate(objRS.Fields(2)) + CDate(objRS.Fields(3))) <> (CDbl(.Cells(2, 3) + .Cells(2, 4)))) Or (objRS.Fields(0) <> .Cells(2, 1)) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(3).NumberFormat = "DD.MM.YYYY"
                .Columns(4).NumberFormat = "HH:MM:SS"
              Else
                MsgBox "Doppelte Daten für 'FP " & strSheet & "'!" & vbLf & _
                  "Datei '" & strFile & "' wird übersprungen!"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
  Next
  
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub

Gruß Sepp

AW: Hier geht's weiter!
26.11.2017 22:28:59
GP123
Ok Danke dann bleibt das so.
Vielen Dank für deine Hilfe.
AW: Hier geht's weiter!
26.11.2017 22:29:10
GP123
Ok Danke dann bleibt das so.
Vielen Dank für deine Hilfe.
AW: Hier geht's weiter!
26.11.2017 22:50:35
GP123
Eine Frage hätte ich doch noch. Sorry.
Kann ich mir noch in Spalte E den zusammengerechneten wert von Datum und Zeit zurückgeben lassen?
AW: Hier geht's weiter!
26.11.2017 23:03:23
Sepp
Hallo Anne,
bitte sehr.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = vntItem
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strPath = Mid(vntFiles(lngI), 1, InStrRev(vntFiles(lngI), "\"))
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [PNR], [FP], [TAG], [MELDEZEIT] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(1)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (CDbl(CDate(objRS.Fields(2)) + CDate(objRS.Fields(3))) <> (CDbl(.Cells(2, 3) + .Cells(2, 4)))) Or (objRS.Fields(0) <> .Cells(2, 1)) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(3).NumberFormat = "DD.MM.YYYY"
                .Columns(4).NumberFormat = "hh:mm:ss"
                .Columns(5).NumberFormat = "DD.MM.YYYY hh:mm:ss"
                .Cells(1, 5) = "MELDEZEIT2"
                .Range(.Cells(2, 5), .Cells(Application.Max(2, Application.CountA(.Columns(1))), 5)).FormulaR1C1 = "=RC[-2]+RC[-1]"
              Else
                MsgBox "Doppelte Daten für 'FP " & strSheet & "'!" & vbLf & _
                  "Datei '" & strFile & "' wird übersprungen!"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
  Next
  
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub

Das war's aber für heute ;-))
Gruß Sepp

AW: Hier geht's weiter!
26.11.2017 23:10:46
GP123
Danke.
Ja Super das klappt prima.
Jetzt versuche ich noch in Spalte 2 wieder eine Zahl zu bekommen und dann passt das alles.
Nochmal vielen Dank
AW: Hier geht's weiter!
26.11.2017 23:36:08
GP123
Danke.
Ja Super das klappt prima.
Jetzt versuche ich noch in Spalte 2 wieder eine Zahl zu bekommen und dann passt das alles.
Nochmal vielen Dank
AW: Hier geht's weiter!
27.11.2017 00:03:14
GP123
Hallo Sepp,
ist das normal das die Schema.ini auf dem Desktop liegen bleibt?
Oder soll die eigentlich gelöscht werden?
AW: OT: Und wenn sie nicht gestorben sind, ...
27.11.2017 12:28:44
GP123
Vielen Dank für die Meldung Schlaufuchs.
Hast du noch sinnvolle Beiträge oder warst du jetzt nur der Meinung dich einmal wichtig machen zu müssen?
Si tacuisses, philosophus mansisses! ...
27.11.2017 12:53:12
Luc:-?
Fällt dir wirklich nicht auf, wie aberwitzig die Struktur deines Threads im Vgl mit anderen aus­sieht! Auch jetzt hast du meinen Betreff einfach nur wieder übernommen! Das wirkt wie Nachäfferei und hat keinerlei Inhaltsbezug. Das schreckt AWer ab, denn man sieht keinen Fortschritt (wer will da schon alles nachlesen müssen)! Und solchen offen­sicht­lich bequemen und fantasie­losen Leuten helfe ich idR nicht, vor allem dann nicht, wenn sie mir auch noch ohne Not dumm kommen… :-[
Luc :-?
Wenn du meinst
27.11.2017 12:55:06
GP123
Ich stelle mir die Frage was du hier für einen Auftrag hast?
Was kümmert dich das?
Excel gut-Benehmen miserabel ?
27.11.2017 16:32:15
robert
Auftrag ist: Meinungen bekunden, auch wenn es Dir nicht passt!
Meinungen bekunden, auch wenn es Dir nicht passt!
27.11.2017 17:05:23
Daniel
Menschen, die sich auf "Meinung bekunden" beschränken, sind in Foren normalerweise eher unbeliebt.
Abschluss
27.11.2017 17:28:59
GP123
Ich wollte jetzt hier keine miese Stimmung verbreiten.
Das war nicht der Sinn.
@ Sepp: Danke für deine Bemühungen. Du hast mir sehr geholfen.
@ Robert: Ich bin für jede konstruktive Meinung sehr offen, wenn es zum Thema passt und sich nicht um Nichtigkeiten handelt die schon lange erledigt waren.
Dazu auch nochmal Danke an Sepp das du wieder links angefangen hast.
Mir war nicht ganz klar wie ich das mache. Aber jetzt bin ich schlauer.
@Luc?: Der Ton macht die Musik.
AW: Abschluss
27.11.2017 18:03:29
Sepp
Hallo Anne,
am besten einfach ignorieren!
Luc? ist zwar DER Experte für eh alles, aber seine Monologe sind meistens zum wegschnarchen.
Gruß Sepp

Vielen Dank, Sepp, für deine 'hohe' Meinung ...
28.11.2017 12:38:45
Luc:-?
…von mir, die ich dir gern zurückgebe. Hättest du nicht jahrelang pausiert, wäre dir evtl aufgefallen, dass ich mich auf Bestimmtes spezialisiert habe (weshalb ich auch zu Xl-[Er-]Kenntnissen kommen konnte, die außerhalb normaler FragenBeantwortung liegen) und nicht auf alles, so wie du (fast). Außerdem scheinst du auch zu denjenigen zu gehören, die die Arbeit anderer kaum mal würdi­gen, da sie ja die jeweilige Quelle ihrer Intentionen ohnehin vergessen, während ich genau weiß, was auf FremdEinfluss zurück­ging und was nicht. Dabei müsste ich doch der Vergesslichere sein, weil deutlich älter! Dazu passt auch sehr gut, dass du bei mei­nen „Monologen wegschnarchst“. Würdest du sie dagegen aufmerksam verfolgen, so wie mancher hier, hättest du auch noch was lernen können. Aber das liegt wohl nicht in deinem Interesse, denn du weißt ja schon alles! Dazu sagt der Berliner: Innbildung iss ooch 'ne Bildung! :->
Außerdem ging's bei meinem OT-Einwurf nur um die abschreckende Gestaltung der Thread-Struktur, ein regelmäßiger KritikPkt auch von WF (!), und nicht um den dahinter verborgenen Inhalt, weshalb euer beider Reaktion darauf schlicht noch unver­ständ­licher ist als das Zustande­kommen­lassen dieser Struktur…
Luc :-?
AW: Vielen Dank, Sepp, für deine 'hohe' Meinung ...
28.11.2017 20:14:55
Sepp
Hallo Luc,
also ich weiß sicher nicht alles, bei weitem nicht, muss ich auch nicht, da XL nach wie vor "nur" eines meiner Hobbys ist. Kann mich auch nicht erinnern, jemals auch nur irgent etwas in diese Richtung behauptet zu haben.
Dein Fachwissen mach ich Dir nicht streitig, wie auch. Allerdings ist dies ein Anwenderforum, und genau so gestalte ich meine Beiträge. Die Fragesteller wollen für ein konkretes, (na ja, manchmal auch weniger konkret) Problem, eine Lösung erhalten. Die meisten haben gar nicht die Zeit und vielleicht auch nicht die Lust, tiefer in die Materie einzudringen. Wenn du dein Auto in die Werkstätte bringst, dann willst du ja auch nicht einen Lehrgang als KFZ-Techniker aufgeschwätzt bekommen, oder?
Deine Beiträge gehören oft eher in ein Entwickler-/Programmierer-Forum.
Ich zweifle nicht an deinem Umfassenden Wissen, allerdings mag ich Deinen Stil nicht, ist aber mein Problem, obwohl es für mich keines ist.
Und darüber, ob ich was "dazulernen" will oder nicht, brauchst du dich nicht sorgen.
Noch kurz zum Thema Thread-Struktur/Überschriften. Wer neue Überschriften erstellen will, soll das machen, ich mache es meist nicht. Halbe Sätze in der Überschrift sind auch nicht immer hilfreich, das das Forum hier keine Vorgaben macht, sollte das jeder so halten wie er will, auch wenn WF und andere sich darüber aufregen.
Gruß Sepp

Naja, das 'hört' sich nun ja besser an¹, ...
01.12.2017 02:29:48
Luc:-?
…Sepp,
aber mein xl-bezügliches „Hobby“ besteht eben nicht darin, möglichst viele mehr oder weniger interessante Fragen zu beant­wor­ten, sondern neue Erkenntnisse zu gewinnen und Neues, auch Ideen Anderer, zu erproben und ggf zu verallgemeinern u/o zu erwei­tern. Dazu gehört natürlich auch, dass ich den Ideen­geber benenne, falls er namentlich bekannt ist (vgl Anfänge der Verbund­Zellen-Diskussion bzw die WENN-/WAHL-Problematik).
Anfänglich war dieses Forum zur AnfragenBehandlung da, für Diskussionen gab's ein anderes (ist oft in anderen Foren heute noch so). Hier gibt's dieses DiskussionsForum aber schon lange nicht mehr, weshalb nun auch Diskussionen in diesem hier geführt wdn müss(t)en. Die Diskussionen von Werner (neopa) und mir wurden von einem Mitleser auch schon mal als lehrreich¹ erwähnt…
Ich sehe auch nicht, inwiefern erweitertes und Hintergrundwissen einem Nutzer hier schaden sollte, denn immerhin befasst er sich ja mit diesem Werkzeug² und viele wollen auch (noch) lernen und nicht nur eine Fertig­Lösung. Die Wahrheit hat einst wohl eher neopa ausgesprochen, eine Lösung zu erklären macht mehr Arbeit als die Lösung selbst (und auch weniger Spaß!). Außerdem behaup­ten etliche AWer oft und gern, dass auch sie lernen wollen bzw dass man voneinander lernt. In letzter Zeit muss ich diese Pauschal­Aussage leider immer häufiger bezweifeln (wobei sie für mich weiterhin gilt, ich aber, ebenso wie Du, auch nicht mehr alles lernen will, weil ich für alles nicht mehr Zeit und Nerven habe)!
Was den Betreff betrifft — den hattest Du mit Deinem 2.Beitrag durch eine Kurz-AW geändert (und später erneut). Wer so etwas macht, das dann aber über x Beiträge beibehält, obwohl es dann garantiert nicht mehr zum Inhalt passt, hat keine Ausrede mehr…! Wäre immer der Anfangsbetreff übernommen worden, hätte es auch unschön ausgesehen, aber ich hätte wahrscheinlich keinen OT-Kommentar einge­schoben — ich bin ja nicht WF! :-]
Ansonsten habe ich ja auch nichts gg Deine Beiträge (höchstens dann, wenn Du Deine eigenen Arbeiten vergisst! :-]). Deine Pgmm bewegen sich quer durch die VBA-Möglichkeiten und sind idR anspruchsvoll; Deine Fml-Lösungen dito, wobei das ja auch ein beson­deres Talent sein mag, man beides zusammen aber eher seltener findet…
¹ Dir ist doch klar, dass ich Deine „Wegschnarch“-Bemerkung als fachlich unbegründete diffamierende Abwertung (wie einst durch Beverly) verstehen musste…‽
² Dein Kfz-Werkstatt-Bsp hinkt, denn dort beanspruche ich eine zu bezahlende Dienstleistung, was aber hier nicht der Fall ist. Das oberste Credo dieses und vieler ähnlicher Foren lautet ja gerade Hilfe zur Selbsthilfe! Wir sind hier ja nicht bei hausaufgaben.de !

Morrn, Luc :-?
AW: Import von CSV Datei in Arbeitsmappe
27.11.2017 19:17:58
CSV
Hallo Sepp,
ich habe das alles gerade ausprobiert und festgestellt das er mich im Ordner wo die CSV liegen keine Schema.ini machen lässt. Kann ich diese evtl. in dem Ordner wo die Zieldatei liegt erstellen?
AW: Import von CSV Datei in Arbeitsmappe
27.11.2017 20:08:59
CSV
Hallo Anne,
nein, die schema.ini muss im selben Verzeichnis liegen.
Gruß Sepp

AW: Import von CSV Datei in Arbeitsmappe
27.11.2017 21:31:20
CSV
Schade.
Wäre es möglich die ausgewählten Dateien in einen Zielordner zu kopieren, dann damit zu arbeiten und dort die schema.ini zu erstellen und im Anschluss die Dateien und die ini wieder zu löschen?
AW: Import von CSV Datei in Arbeitsmappe
28.11.2017 19:53:32
CSV
Hallo Anne,
sicher geht das.
Sub importCSV()
Dim objADO As Object, objRS As Object
Dim strFile As String, strSQL As String
Dim vntFiles As Variant, vntItem As Variant, objWS As Worksheet, strSheet As String
Dim lngI As Long, lngN As Long, lngRow As Long
Dim strTempPath As String

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .AllowMultiSelect = True
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strTempPath = Environ("Temp") & "\"
    Redim vntFiles(.SelectedItems.Count - 1)
    For Each vntItem In .SelectedItems
      vntFiles(lngI) = strTempPath & Mid(vntItem, InStrRev(vntItem, "\") + 1)
      Call FileCopy(vntItem, vntFiles(lngI))
      lngI = lngI + 1
    Next
  End If
End With

If lngI > 0 Then
  For Each objWS In ThisWorkbook.Worksheets
    If objWS.Name Like "Import *" Then
      objWS.UsedRange.ClearContents
    End If
  Next
  For lngI = 0 To UBound(vntFiles)
    strFile = Mid(vntFiles(lngI), InStrRev(vntFiles(lngI), "\") + 1)
    
    If Len(strFile) Then
      
      If MakeSchemaINI(strFile, strTempPath) Then
        Set objADO = CreateObject("ADODB.CONNECTION")
        objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strTempPath & "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
        
        Set objRS = CreateObject("ADODB.RECORDSET")
        
        strSQL = "SELECT [PNR], [FP], [TAG], [MELDEZEIT] From [" & strFile & "]"
        
        objRS.Open strSQL, objADO, 3, 1, 1
        
        If Not objRS.EOF Then
          strSheet = objRS.Fields(1)
          If SheetExist("Import " & strSheet) Then
            With Sheets("Import " & strSheet)
              lngRow = Application.Max(2, Application.CountA(.Columns(1)) + 1)
              If lngRow = 2 Then
                For lngN = 1 To objRS.Fields.Count
                  .Cells(1, lngN) = objRS.Fields(lngN - 1).Name
                Next
              End If
              If lngRow = 2 Or (CDbl(CDate(objRS.Fields(2)) + CDate(objRS.Fields(3))) <> (CDbl(.Cells(2, 3) + .Cells(2, 4)))) Or (objRS.Fields(0) <> .Cells(2, 1)) Then
                .Cells(lngRow, 1).CopyFromRecordset objRS
                .Columns(3).NumberFormat = "DD.MM.YYYY"
                .Columns(4).NumberFormat = "hh:mm:ss"
                .Columns(5).NumberFormat = "DD.MM.YYYY hh:mm:ss"
                .Cells(1, 5) = "MELDEZEIT2"
                .Range(.Cells(2, 5), .Cells(Application.Max(2, Application.CountA(.Columns(1))), 5)).FormulaR1C1 = "=RC[-2]+RC[-1]"
              Else
                MsgBox "Doppelte Daten für 'FP " & strSheet & "'!" & vbLf & _
                  "Datei '" & strFile & "' wird übersprungen!"
              End If
            End With
          Else
            MsgBox "Keine Tabelle für 'FP " & strSheet & "' gefunden!"
          End If
        End If
        objRS.Close
        objADO.Close
      End If
      
    End If
    Kill vntFiles(lngI)
  Next
  Kill strTempPath & "schema.ini"
End If

Set objADO = Nothing
Set objRS = Nothing
End Sub

Gruß Sepp

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige