Thema Datum  Von Nutzer Rating
Antwort
Rot Automatisierungs Skript das ebenfalls automatisch all 5h automatisch laufen soll
 28.11.2017 15:42:24 Aston
NotSolved

Ansicht des Beitrags:
Von:
Aston		 Datum:
28.11.2017 15:42:24		 Views:
1068		 Rating:
     
Antwort:
  Ja
Thema:
Automatisierungs Skript das ebenfalls automatisch all 5h automatisch laufen soll

Hallo

Ich möchte gern ein Skript schrieben, dass ein Excel File z.B \blabla\bla1_Datum nimmt und dann in einem anderen Ordner alle Excel Files die dort drin sind überprüft, ob der Wert in den jeweiligen Spalten B2 (ein Datum) der Files mit dem Datum im Filenamen, in diesem Fall \blabla\bla1_Datum übernimmt. Wenn Ja werden bestimmte Spalten A2, B2, usw. bis J2 in das File \blabla\bla1_Datum übertragen. Und das macht es mit jedem File im diesem Ordner. Am Schluss speichert es alles und nimmt dann das nächste File \blabla\bla2_Datum und geht wieder in diesem Ordner Files durch und macht nochmal das gleiche und wird dann automatisch gespeichert. Und das Skript soll das solange mach bis es kein File mehr findet der \blabla\bla(hier kommt dann eine Nummer) _Datum heisst. Das heisst bei jedem Durchlauf soll das Datum und die Nummer im Filename um eins erhört werden bis kein File mehr findet das so heisst.

Das ist was ich bis jetzt habe und habe mir gedacht das Ganze in eine Schleife zupacken und die Variable num und das Datum bei jedem durchlauf um eins zu erhöhen.Option Explicit

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Compare Text
   
Const Folder = "D:\Test_Umgebung\Orders_xlsx"
   
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
Dim Wkb2 As Workbook
 
       
aktDate = "17.10.2017"
num = "1"
 
       
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
       
Workbooks.Open "D:\Test_Umgebung\xls_File_pro_Migrationstag\UC50_SAFE_LAURA_" & aktDate & "--" & num & ".xlsx"
Set Wkb2 = Workbooks.Open("D:\Test_Umgebung\xls_File_pro_Migrationstag\UC50_SAFE_LAURA_" & aktDate & "--" & num & ".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
                    'Wenn Feld B2 aus dem File orders.xls =
                    'das Datum das beim neuen File eingeben wurde dann coppy Restliche Felder
                    If Wkb.Sheets(1).Range("B2").Value = aktDate Then
                          
                        '### Ermitteln der ersten freien Zelle in Spalte A ###
                        Zeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
                        '### Wenn erste freie Zeile kleiner 3 dann in 3 beginnen ###
                        If Zeile < 3 Then Zeile = 3
                        .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
    End If
Next
  
With Application
    .ScreenUpdating = True
    .AskToUpdateLinks = True
    .DisplayAlerts = True
End With
Wkb2.Save
Workbooks.Close
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Automatisierungs Skript das ebenfalls automatisch all 5h automatisch laufen soll
 28.11.2017 15:42:24 Aston
NotSolved