Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA: Quelldateien schließen
#1
Hallo zusammen,

ich habe mit meinen beschränkten VBA-Kenntnissen und dem Tool "Makro Aufzeichnen" irgendwie drei halbwegs funktionierende Makros gebaut.

Die Idee war: es gibt unterschiedliche Dateien die unterschiedliche Namen haben können (aber nicht müssen) und/oder deren Dateipfad unterschiedlich ist.
Excel sollte nun die Daten in eine Datei importieren, damit ich das nicht händisch jedesmal rüberkopieren muss.

Soweit, sogut. Klappt auch alles Prima. Nur:
Es kann vorkommen, dass die Quelldatei den gleichen Namen hat, wie eine vorherige Quelldatei (da auch die Datenquelle identisch ist, nur der Inhalt ist ein anderer).
Dann funktioniert das Makro auch nicht richtig, da im Hintergrund die Quelldatei (noch) geöffnet ist.

Ich habe jetzt schon einige Befehle die ich bei google gefunden habe ausprobiert, um das Problem zu lösen, aber offenbar bin ich zu doof dafür.

Um mein Problem zu veranschaulichen, hier nochmal Klartext:

Die Quelldatei trägt meinetwegen den Namen "Objects.xlsx". Ich rufe über eines meiner Makros die Datei auf, der Inhalt der Objects.xlsx wird in die aktive Tabelle kopiert und ggf. umformatiert.
Wenn ich den vorgang dann abschließe und eine neue "Objects.xlsx" auswähle um damit den Vorgang zu wiederholen, aber die alte "Objects.xlsx" noch offen ist, kopiert er aus einer anderen Tabelle die Daten herüber, aber aus keiner "Objects.xlsx" weder der alten noch der aktuellen.

Mein Wunsch ist, dass nach dem Rüberkopieren der Daten die Quelldatei automatisch geschlossen wird, sodass ich das Makro sofort für eine andere Datei verwenden kann, ohne dafür erst zick Fenster zu schließen, die sich bei der Benutzung des Makros geöffnet haben.

Ich habe darüber hinaus unterschiedliche Codes für unterschiedliche Dateien und Formate:

Hier mein CSV-Import:
Code:
Sub Quelldatei_auswählen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung


 Dim i&, n&
 Dim Zeile As String
 Dim Ergebnis As Variant
 Dim DateiName As Variant
 DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
 If DateiName <> False Then
   i = 1
   Open DateiName For Input As #1
   Do While Not EOF(1)
     Line Input #1, Zeile
     Ergebnis = Split(Zeile, ";")
     For n = 0 To UBound(Ergebnis)
       Cells(i, n + 1) = Ergebnis(n)
     Next
     i = i + 1
   Loop
   Close #1
 End If

   Cells.Select 'Wähle alle Zellen aus
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei




Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(1).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(1).Cells(1, 1).Select 'zeigt Zieldatei wieder an

'Hier können die gewünschten Sonderzeichen entfernt werden:

   Columns("A:A").Select
   Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False 'entfernt Sonder- und Leerzeichen
       

End Sub

Und hier der andere Code für eine Datei, die Systembedingt umformatiert, aber wieder zurückformatiert werden muss (aus XLS[X]):
Code:
Sub Fehlerliste_Waehlen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung

Application.Dialogs(xlDialogOpen).Show 'öffne Quelldatei
   Cells.Select
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei

Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(1).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(1).Cells(1, 1).Select 'zeigt Zieldatei wieder an
'Hier findet die Umformatierung statt:
[...]
   Range("B2").Select

End Sub



Dieser Code ist für eine gänzlich andere Datei:
Code:
Sub Bestandsdatei_Auswaehlen()

Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung

Application.Dialogs(xlDialogOpen).Show 'öffne Quelldatei
   Cells.Select
   Selection.Copy
Worksheets(1).Range("1:1048576").Copy 'kopiere alles zur Zieldatei
'ActiveWindow.Close

Ziel.Worksheets(2).Activate 'wechselt zur Zieldatei zurück
Ziel.Worksheets(2).Range("1:1048576").PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False 'setzt Zwischenablage in Datei ein

Worksheets(2).Cells(1, 1).Select 'zeigt Zieldatei wieder an

'CSV-Trenner (wird derzeit nicht verwendet):
'    Columns("A:A").Select
'    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
'        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
'        Semicolon:=True, Comma:=False, Space:=False, Other:=False, 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), Array(11, 1), Array(12, 1)), _
       TrailingMinusNumbers:=True

'Sonderzeichen entfernen:
   Columns("A:A").Select
   Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False



End Sub
Meine Bitte an der Stelle:
An welcher Stelle muss ich welchen Befehl eingeben, damit die jeweilige Quelldatei geschlossen wird?
Schön wäre, wenn alle kopierten Werte in der Zwischenablage verbleiben, auch, wenn die Quelldatei bereits geschlossen wurde (falls das machbar ist), wäre aber auch OK falls das nicht geht.

Ich hoffe ihr habt eine einigermaßen unkomplizierte Lösung für mich.

Vielen Dank!
Antworten Top
#2
Hallo,

zu dem Code gäbe es noch einiges zu sagen, nur soviel: warum liest du die CSV-Daten nicht gleich in die "ZIEL"-Tabelle, sondern kopierst die erst aus einer Zwischendatei ???

Um die Frage zu beantworten, ich hab mal 3 Zeilen ergänzt (und eine gestrichen), ich hoffe du verstehst was gemeint ist:

Code:
Sub Quelldatei_auswählen()
  Dim Ziel As Workbook, Temp As Workbook
  Set Ziel = ThisWorkbook
  Dim i&, n&
  Dim Zeile As String
  Dim Ergebnis As Variant
  Dim DateiName As Variant
  DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
  If DateiName <> False Then
    Set Temp = Workbooks.Add 'ergänzt
    i = 1
    Open DateiName For Input As #1
    Do While Not EOF(1)
      Line Input #1, Zeile
      Ergebnis = Split(Zeile, ";")
      For n = 0 To UBound(Ergebnis)
        Cells(i, n + 1) = Ergebnis(n)
      Next
      i = i + 1
    Loop
    Close #1
  Else 'keine csv-Datei ausgewählt
    Exit sub
  End If

  Cells.Select
  Selection.Copy
  'Worksheets(1).Range("1:1048576").Copy 'Überfüssig und syntaktisch unklar
  Ziel.Worksheets(1).Activate
  Ziel.Worksheets(1).Cells(1, 1).Paste 'geändert
  Application.CutCopyMode = False
  Temp.Close False 'ergänzt
  Worksheets(1).Cells(1, 1).Select
  'Ab hier entfernen bestimmter Zeichen, wie bisher
  '...
End Sub
vg, MM
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste