Rausschreiben der Dateinamen in Excel

  • Excel

Es gibt 16 Antworten in diesem Thema. Der letzte Beitrag () ist von Odi123.

    Rausschreiben der Dateinamen in Excel

    Hallo liebe Forum-Gemeinde,

    ich habe mich hier angemeldet, weil ich nicht mehr weiter weis. Ich muss immoment ein Programm in der Arbeit schreiben, welches mehrere Dateien zusammenfügt (in meinem Fall xlsx). Soweit so gut. Das Zusammenfügen funktioniert bis jetzt einwandfrei. Mein Problem ist nun, das mein Chef möchte, dass ich in Spalte A den Dateinamen schreibe, aus welcher Datei die betreffende Zeile stammt. Ich bin neu in Visual Basic und hab kaum erfahrungen, hab mir vieles aus dem Internet geholt und zusammen gefummelt. Ich hoffe mir kann jmd. helfen, es eilt sehr.

    Vielen Dank, euere Odi

    Visual Basic-Quellcode

    1. Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
    3. On Error GoTo errExit
    4. Dim WBQ As Workbook
    5. Dim WBZ As Workbook
    6. Dim varDateien As Variant
    7. Dim lngAnzahl As Long
    8. Dim lngLastQ As Long
    9. Dim x As Integer
    12. Set WBZ = ActiveWorkbook
    13. 'Altdaten auf Zielblatt löschen
    14. WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
    17. varDateien = _
    18. Application.GetOpenFilename("Excel-Arbeitsmappe (*.xlsx),*.xlsx" & "Excel 97-2003-Arbeitsmappe (*.xls; *.xlsm),*.xls; *.xlsm,", False, "Bitte gewünschte Datei(en) markieren", False, True)
    20. With Application
    21. .ScreenUpdating = False
    22. .EnableEvents = False
    23. .Calculation = xlCalculationManual
    24. End With
    26. 'Lese Tabellenüberschriften aus
    27. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    28. Range("A1").Value = "SOURCE_FILE" 'Beschriftet Spalte A für den Dateipfad
    29. Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
    30. WBQ.Worksheets(1).Range("A1:Z1").Copy _
    31. Destination:=WBZ.Worksheets(1).Range("B" & WBZ.Worksheets(1).Range("B65536").End(xlUp).Row + 0)
    32. WBQ.Close
    33. Next
    36. 'Lese Tabelleninhalt aus
    38. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    39. x = ActiveSheet.Cells(1048576, 2).End(xlUp).Row + 1 'Soll mir die Größe des Excels bestimmen
    40. Range("A2:A" & x).Value = varDateien 'Soll Dateien in Spalte A schreiben -> funktioniert leider nicht. Ich bekomme immer die letzte Zeile aus der Variante und das rein schreiben funktioniert auch nicht wirklich
    41. Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
    42. lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
    43. WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
    44. Destination:=WBZ.Worksheets(1).Range("B" & WBZ.Worksheets(1).Range("B65536").End(xlUp).Row + 1)
    45. WBQ.Close
    47. Next
    50. With Application
    51. .ScreenUpdating = True
    52. .EnableEvents = True
    53. .Calculation = xlCalculationAutomatic
    54. End With
    56. MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
    58. Exit Sub
    60. errExit:
    61. With Application
    62. .ScreenUpdating = True
    63. .EnableEvents = True
    64. .Calculation = xlCalculationAutomatic
    65. End With
    67. If Err.Number = 13 Then
    68. MsgBox "Es wurde keine Datei ausgewählt"
    69. Else
    70. MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
    71. & "Fehlernummer: " & Err.Number & vbCr _
    72. & "Fehlerbeschreibung: " & Err.Description
    73. End If
    75. End Sub

    Hi und Willkommen.

    So erhältst du die letzte Zeile in Column "A" + 1 für die erste freie

    Visual Basic-Quellcode

    1. Dim lastrow as Long
    2. lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1


    So verwendet man das Array und schreibt den Wert rein:

    Visual Basic-Quellcode

    1. Dim lastrow
    2. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    3. 'Range("A2:A" & x).Value = varDateien
    4. lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    5. Sheets(1).Cells(lastrow, 1).Value = varDateien(lngAnzahl)


    Wieso hast denn solche Aufgaben wenn du dich damit Nüsse auskennst :D


    //Edit:

    eigentlich brauchst du ja lastrow nicht mal, ist ja eh fixiert wo es losgeht:

    Visual Basic-Quellcode

    1. ​
    2. dim rowCounter as long
    3. rowCounter = 1
    4. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    5. rowCounter = rowCounter + 1
    6. Sheets(1).Cells(rowCounter, 1).Value = varDateien(lngAnzahl)
    7. ..
    9. Next
    Das ist meine Signatur und sie wird wunderbar sein!

    Mono schrieb:

    Visual Basic-Quellcode

    Dim lastrow
    For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    'Range("A2:A" & x).Value = varDateien
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets(1).Cells(lastrow, 1).Value = varDateien(lngAnzahl)


    Also ich hab das jetzt nach dieser Version von dir gemacht und bekomme auch endlich die richtigen Werte raus :)

    VB.NET-Quellcode

    1. 'Lese Tabelleninhalt aus
    2. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    3. lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    4. Sheets(1).Cells(lastrow, 1).Value = varDateien(lngAnzahl)
    5. Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
    6. lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
    7. WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
    8. Destination:=WBZ.Worksheets(1).Range("B" & WBZ.Worksheets(1).Range("B65536").End(xlUp).Row + 1)
    9. WBQ.Close
    11. Next


    Mein Problem ist jetzt nur, das er nur 3 Zeilen anstatt 6 befüllt, also irgendwie nur die Hälfte? :|

    Zu deiner Frage: Ich soll das lernen ;)

    Hab ich gemacht; Da kommt dann das selbe Ergebnis :o

    Jeder dieser 3 Source_Files hat 2 Zeilen -> Insgesamt müssen 6 eingelesen werden, aus jeder 2, also stimmt das schonmal. Nur macht er halt nur bei den ersten 3 die Source File, auch mit deiner Edit Variante.


    SOURCE_FILE
    		Name
    		Geschlecht
    		Wohnort
    C:\Users\Z003DJCT\Desktop\Test1 - Kopie (2).xlsx
    		Marina
    		WMünchen
    C:\Users\Z003DJCT\Desktop\Test1 - Kopie.xlsx
    		Brunhilde
    		W
    		Nürnberg
    C:\Users\Z003DJCT\Desktop\Test1.xlsx
    		Geier
    		M
    		München

    		Klaus
    		M
    		Hannover

    		Rudolf
    		M
    		Berlin

    		Günther
    		W
    		Hamburg

    Ok, jetzt verstehe ich das Problem erst.


    Visual Basic-Quellcode

    1. Dim lastrowB as Long
    2. Dim lastrowA as Long
    3. For lngAnzahl = LBound(varDateien) To UBound(varDateien)
    4. Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
    6. lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
    7. WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
    8. Destination:=WBZ.Worksheets(1).Range("B" & WBZ.Worksheets(1).Range("B65536").End(xlUp).Row + 1)
    9. WBQ.Close
    11. lastrowA = Cells(Rows.Count, "A").End(xlUp).Row + 1
    12. lastRowB = Cells(Rows.Count, "B").End(xlUp).Row
    13. Sheets(1).Range(Cells(lastRowA,1), Cells(lastRowB, 1)).Value = varDateien(lngAnzahl)
    15. Next


    Ich würde dir übrigens eher von Copy abraten. Du kannst auch einfach die Value Eigenschaften beider Ranges verwenden und diese zuweisen (wenn dir die Formatierung unwichtig ist)
    Das ist meine Signatur und sie wird wunderbar sein!

    Wenn du es lernen sollst, dann empfehle ich dir, dich damit zu beschäftigen. Lieber länger brauchen und selber hinbekommen als schnell schnell und nicht wirklich kapieren was man tut.
    Du hast jetzt einen Ansatz bekommen, wie du es theoretisch auch ohne Copy machen könntest. (ist das selbe Prinzip wie dein eigentliches Problem) ;)

    Hf
    Das ist meine Signatur und sie wird wunderbar sein!

    Jetzt hab ich doch noch mal ne Frage. Und zwar soll, nachdem ich alles hübsch eingelesen wurde, das Ergerbnis in einer NEUEN Datei gepseichert werden. Ich habe das jetzt folgendermaßen gelöst:

    VB.NET-Quellcode

    1. MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
    2. Call CommandButton1_Click
    3. WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
    4. Exit Sub
    6. errExit:
    7. With Application
    8. .ScreenUpdating = True
    9. .EnableEvents = True
    10. .Calculation = xlCalculationAutomatic
    11. End With
    13. If Err.Number = 13 Then
    14. MsgBox "Es wurde keine Datei ausgewählt"
    15. WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
    16. Application.Quit
    17. Application.DisplayAlerts = False
    18. ActiveWorkbook.Close savechanges:=False
    19. Else
    20. MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
    21. & "Fehlernummer: " & Err.Number & vbCr _
    22. & "Fehlerbeschreibung: " & Err.Description
    23. End If
    25. End Sub
    27. Private Sub CommandButton1_Click()
    29. Application.DisplayAlerts = False
    31. ' Dateiname und Pfad in Variable speichern
    32. template_file = ActiveWorkbook.FullName
    34. fileSaveName = Application.GetSaveAsFilename( _
    35. InitialFileName:=ThisWorkbook.Path & ThisWorkbook.Name + ".txt", _
    36. fileFilter:=" Excel-Arbeitsmappe (*.xlsx), *.xlsx," & _
    37. " Excel-Arbeitsmappe mit Makros (*.xlsm), *.xlsm," & _
    38. " Excel 97-2003-Arbeitsmappe (*.xls), *.xls," & _
    39. " Text (*.txt), *.txt")
    41. If fileSaveName = False Then
    42. Exit Sub
    43. End If
    45. file_name_saved = ActiveWorkbook.FullName
    46. MsgBox "Datei erfolgreich gespeichert unter: " & vbCr & vbCr & file_name_saved
    48. End Sub


    Meine Probleme sind jetzt Folgende:

    1. Wie kann ich den Dateinamen im Speichern Unter Fenster vorgeben? Also z.B. mein aktuelles Worksheet und mein aktuelles Dateiformat? Ich hab zwar schon was versucht, aber das geht irgendwie nicht.
    2. Ich kann bereits alles schön speichern aber hab das Problem, das wenn ich es gespeichert hab und mein Excel schließe, dass es mir meine Datei komplett zerschießt und er anscheinend keine neue Datei anlegt, sondern das Ergebnis fest in der aktuellen Datei speichert, welche aber NUR als Arbeitsgrundlage dienen soll und nicht das Ergebnis beinhalten soll.

    Vielen vielen Dank!

    LG Odi

    1. Wie kann ich den Dateinamen im Speichern Unter Fenster vorgeben?

    Visual Basic-Quellcode

    1. fileSaveName = Application.GetSaveAsFilename( _
    2. InitialFileName:= ThisWorkbook.Name, _
    3. fileFilter:=" Excel-Arbeitsmappe (*.xlsx), *.xlsx," & _
    4. " Excel-Arbeitsmappe mit Makros (*.xlsm), *.xlsm," & _
    5. " Excel 97-2003-Arbeitsmappe (*.xls), *.xls," & _
    6. " Text (*.txt), *.txt")


    Hast doch schon dastehen, nur verwende halt nicht ".txt" sondern einfach nur ThisWorkbook.Name.

    Wenn du das verwendest:

    Visual Basic-Quellcode

    1. Set WBZ = ActiveWorkbook


    Dann schreibst du logischerweise alles ins aktive Workbook. Wenn du ein neues haben willst, dann öffne ein neues:

    Visual Basic-Quellcode

    1. ​Set WBZ = Workbooks.Add()
    Das ist meine Signatur und sie wird wunderbar sein!

    Hallo Mono,

    super jetzt hab ich das auch! Hab tausend Dank :) Nur jetzt hab ich noch das Problem, das er beim Kopieren auch das Makro mit kopiert, bzw. mein Modul und das darf nicht passieren. Ich habe schon wie ein blöder übers Wochenende Gegoogled, aber leider bin ich nicht wirklich weiter gekommen. Gibt es da ne Möglichkeit beim Kopieren das Modul auszuschließen?

    LG Johannes

    Also halt wenn die Datei als neue Datei gespeichert wird, dann speichert er leider auch das Modul mit in die neue Datei.

    Nochmal kurz zum besseren Verständnis der Sinn meines kleines Programms.
    Das Programm wird per Batch-Datei gestartet und es öffnet sich ein Fenster, worin die Dateien, welche zusammengeführt werden sollen, ausgewählt werden. Dann fügt er die Dateien zusammen und es kommt dann sofort das "Speichern unter" Fenster. Da soll man dann halt den Dateinamen angeben usw., was auch jetzt prima funktioniert. Das Problem ist halt, wenn man dann "Speichern" drückt, dass er das Modul aus meinem Programm mit speichert, was er aber nicht soll, da das Excel nur als Programm dienen soll und nicht als Speicher für die zusammengesetzten Dateien.

    Zeig den Code bitte. Offenbar speicherst du das aktuelle Workbook mit einem neuen Namen. Du musst aber ein NEUES Workbook hinzufügen (Siehe Post 10) und diesem neuen Workbook die Daten reinkopieren und dieses dann speichern.
    Das ist meine Signatur und sie wird wunderbar sein!

    Hab den Code noch etwas vereinfacht übers Wochenende, aber das hat anscheinend nix gebracht.

    VB.NET-Quellcode

    1. Private Sub CommandButton1_Click()
    2. Dim Saved As Boolean
    4. Application.ScreenUpdating = False
    5. Application.DisplayAlerts = False
    6. Saved = True
    7. Saved = Application.Dialogs(xlDialogSaveAs).Show("")
    9. If Saved = False Then
    10. MsgBox "Vorgang abgebrochen!"
    11. Application.Quit
    12. Application.DisplayAlerts = False
    13. ActiveWorkbook.Close savechanges:=False
    14. Exit Sub
    15. End If
    17. Application.DisplayAlerts = True
    18. Application.ScreenUpdating = True
    21. MsgBox "Datei erfolgreich gespeichert!"
    23. End Sub

Facebook