Hallo
In diesem Skript öffne ich ein File und lese Daten hinnen. Nun möchte ich das File indem Daten eingelesen wurde speichern und dann schliessen ohne, dass es mich fragt ob ich sicher bin dass ich es speichern möchte oder mich fragt ob ich die bestehende Datei ersetzen möchte. Bis jetzt konnte ich nichts finde dass, das geöffnete File apeichert und dann schliesst. Dies soll übrigens mit mehren Files passieren also der ganze Code wird dann in einer For Schleife durlaufen, weil diesen Prozess mehre Files durchmachen müssen.
Bedanke mich jetzt schon für eure Hilfe.
LG
Option Explicit
Option Compare Text
Const Folder = "D:\Test_Umgebung\"
Const StartZeile = 3
Public Sub test2()
Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
Dim Datum As Date
Dim num As String
Dim Filename As String
Dim aktDate As Date
Dim Wkb As Workbook, Fso As Object, file As Object, Zeile As Long
Zeile = StartZeile
aktDate = "19.10.2017"
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung aus
.AskToUpdateLinks = False 'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren
.DisplayAlerts = False 'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken
End With
Set Fso = CreateObject("Scripting.FileSystemObject") 'Dateisystem-Operationen
num = 2
Workbooks.Open "D:\Test_File_" & aktDate & "--" & 3 & ".xlsx"
For Each file In Fso.GetFolder(Folder).Files 'Alle _orders.xlsx-Dateien einlesen und eintragen
If Fso.GetExtensionName(file.Name) Like "xlsx" And Fso.GetBaseName(file.Name) Like "*orders*" Then
Set Wkb = GetObject(file.Path)
With Wkb.Sheets(1) 'Werte mit Zahlenformat werden erst geptrüft
If Wkb.Sheets(1).Range("B2").Value = aktDate Then
.Range("A2").Copy: Cells(Zeile, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("B2").Copy: Cells(Zeile, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("C2").Copy: Cells(Zeile, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("D2").Copy: Cells(Zeile, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("E2").Copy: Cells(Zeile, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("F2").Copy: Cells(Zeile, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("G2").Copy: Cells(Zeile, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H2").Copy: Cells(Zeile, "H").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("I2").Copy: Cells(Zeile, "I").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("J2").Copy: Cells(Zeile, "J").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
End With
Wkb.Close False: Zeile = Zeile + 1
End If
Next
Workbooks("D:\Test_Umgebung\xls_File_pro_Migrationstag\test.xlsx").Close SaveChanges:=True
End Sub
|