Noch einmal Hallo an alle,
habe es hinbekommen. Beschreibe mal kurz wie - vieleicht hilft es ja irgendwann auch wem anders!
Problem war eigentlich nur das ich zu Testzwecken die Dateien über einen Dialog ausgewählt habe, nun habe ich das automatische Auswählen aktiviert und er übergeht den Dialog einfach.
Sub Makro3()
Application.DisplayAlerts = False
'öffnen mit auswahl dialog
'Application.Dialogs(xlDialogOpen).Show "c:\W01\*report.*"
' On Error GoTo ende:
'automatisch öffnen
Dim DatVgl1 As Date
Dim Mappe1 As String
Dim ZMappe1 As String
Const n = "c:\W01"
Mappe1 = Dir(n & "\*report.*")
Do Until Mappe1 = ""
DatVgl1 = FileDateTime(n & "\" & Mappe1)
Dat1 = DatVgl1
ZMappe1 = n & "\" & Mappe1
Mappe1 = Dir()
Loop
Workbooks.Open Filename:=ZMappe1
'konvertieren
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1)
Columns("A:A").Select
Range("A1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
R = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For i = R To 1 Step -1
Do While Application.CountA(Rows(i)) = False
Rows(i).EntireRow.Delete
Loop
Next i
Rows("1:30").Select
Selection.Delete Shift:=xlUp
Columns("C:AK").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:R").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 1
'ermittel den namen der activen tabelle
s = ActiveWorkbook.Name
'daten markieren und kopieren
Range("A1:B280").Select
Selection.Copy
'daten.xls öffnen
Dim DatVgl As Date
Dim Mappe As String
Dim ZMappe As String
Const m = "c:\W01"
Mappe = Dir(m & "\daten.xls")
Do Until Mappe = ""
DatVgl = FileDateTime(m & "\" & Mappe)
Dat = DatVgl
ZMappe = m & "\" & Mappe
Mappe = Dir()
Loop
Workbooks.Open Filename:=ZMappe
'kopieren in nächste freie zelle
Set ws2 = Worksheets("Tabelle1")
Range("A" & ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
ActiveSheet.Paste
'Bearbeitete Datei schließen (daten.xls)
With ActiveWorkbook
.Sheets(1).Range("A1").Value = _
"letzte Änderung " & Now & " vom Anwender " & _
Application.UserName
.Close SaveChanges:=True
End With
Application.DisplayAlerts = False
'Bearbeitete Datei schließen z.B.(*.001)
With ActiveWorkbook
.Sheets(1).Range("A1").Value = _
"letzte Änderung " & Now & " vom Anwender " & _
Application.UserName
.Close SaveChanges:=False
End With
Application.DisplayAlerts = False
'abgearbeitete Datei wird aus Hauptverzeichniss gelöscht
On Error GoTo ende:
ChDir "c:\W01"
Kill (s)
ende:
scannen
End Sub
Sub scannen()
'Scanner
'Blendet Exel aus
'Application.Visible = False
Dim dName$
dName = "c:\W01\*report.*"
If Dir(dName) <> "" Then
Makro3
Else
MsgBox "ich habe fertig !!!"
Application.Quit
End If
End Sub