csv-Datei beim Öffnen importieren

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von leclerke.

    csv-Datei beim Öffnen importieren

    Neu

    Hallo,
    ich versuche gerade ein Makro zu ersrellen, dass beim Öffnen von Excel automatisch eine .csv-Datei imporiert. Das funktioniert soweit auch schon ganz gut, nur muss ich (aus dem Beispiel, dass ich gefunden hatte) immer den konkreten Ordnerpfad angeben. Ich hätte gerne, dass einfach die csv-Datei aus dem Ordner imporiert wird, in dem die .xlsm-Datei liegt, egal, wo dieser Ordner nun wiederum auf dem Rechner liegt. Ich bekomme das aber leider nicht hin.
    Hier der bisherige Code:

    Quellcode

    1. Private Sub Workbook_Open()
    2. Const CSVPFAD = "C:\ais_records"
    3. Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
    4. Set fso = CreateObject("Scripting.Filesystemobject")
    5. Set wbTarget = ActiveWorkbook
    6. Application.DisplayAlerts = False
    7. 'Lösche alle Worksheets bevor wir alle neu anlegen
    8. If wbTarget.Worksheets.Count > 1 Then
    9. For i = 1 To wbTarget.Worksheets.Count - 1
    10. wbTarget.Worksheets(i).Delete
    11. Next
    12. End If
    13. For Each f In fso.GetFolder(CSVPFAD).Files
    14. If LCase(Right(f.Name, 3)) = "csv" Then
    15. Workbooks.OpenText Filename:=f.Path
    16. Set wbSource = ActiveWorkbook
    17. On Error Resume Next
    18. Set ws = wbTarget.Worksheets(f.Name)
    19. If Err <> 0 Then
    20. Set ws = wbTarget.Worksheets.Add
    21. ws.Name = f.Name
    22. ws.Range("A:ZZ").Clear
    23. End If
    24. wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
    25. wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
    26. wbSource.Close False
    27. End If
    28. Next
    29. Application.DisplayAlerts = True
    30. Set fso = Nothing
    31. End Sub

    Neu

    Hallo LeClerc,
    so sollte es klappen.

    VB.NET-Quellcode

    1. ​Private Sub Workbook_Open()
    2. Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
    3. Set fso = CreateObject("Scripting.Filesystemobject")
    4. Set wbTarget = ActiveWorkbook
    5. Application.DisplayAlerts = False
    6. ' Lösche alle Worksheets bevor wir alle neu anlegen
    7. If wbTarget.Worksheets.Count > 1 Then
    8. For i = 1 To wbTarget.Worksheets.Count - 1
    9. wbTarget.Worksheets(i).Delete
    10. Next
    11. End If
    12. For Each f In fso.GetFolder(ThisWorkbook.Path).Files
    13. If LCase(Right(f.Name, 3)) = "csv" Then
    14. Workbooks.OpenText Filename:=f.Path
    15. Set wbSource = ActiveWorkbook
    16. On Error Resume Next
    17. Set ws = wbTarget.Worksheets(f.Name)
    18. If Err <> 0 Then
    19. Set ws = wbTarget.Worksheets.Add
    20. ws.Name = f.Name
    21. ws.Range("A:ZZ").Clear
    22. End If
    23. wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    24. TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
    25. wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
    26. wbSource.Close False
    27. End If
    28. Next
    29. Application.DisplayAlerts = True
    30. Set fso = Nothing
    31. End Sub


    Gruß
    Karl-Heinz