csv-Datei beim Öffnen importieren

  • Excel

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

    csv-Datei beim Öffnen importieren

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

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


    Gruß
    Karl-Heinz