User Passwort
 Passwort speichern Passwort vergessen?
 
 
 
 Alle Foren
 PDA-Dev :: Windows Mobile :: eMbedded
 Visual Basic
 Automatisierungs Skript das ebenfalls automatisch
Autor  Thema Nächstes Thema  

aston

Neumitglied


1 Beitrag

Erstellt am: 28.11.2017 :  16:01:19 Uhr  Profil anzeigen  Autor eine Email senden  Antwort mit Zitat
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 durchlaufen um eins zu erhöhen.

 
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
 

   
   Thema Nächstes Thema  
Springe nach:
 
  Bookmark & Share  
 
 
 
  Tags  
   
 
 



pda-dev.de

Quicklinks: Foren-Übersicht | Developer-News | Suche | Impressum

© just-works! Software

Zum Anfang der Seite

Snitz Forums 2000