zeitabhängig speichern :-(((

Hallo Forum,
Paulchen hat sich schon redlich bemüht, aber gesagt ich soll nochmal posten:
In aller Kürze ( die lange Version steht bei Franzi ):
Es geht darum ca 20 Dateien eines Verzeichnisses zu aktualisieren. D.h. Ich mache die erste Datei auf, warte eine Stunde, speicher und mache sie zu. dann kommt die Zweite usw.
Die Stunde braucht man, da die Dateien mit Bloomberg verknüpft sind und das aktualisieren so lange dauert. Un man kann sie nicht gleichzeitig aufmachen, sonst schmiert der Rechner ab.
Hier mal unsere bisherigen Ideen:
da ist aber das Problem, das alle DAteien gleichzeitg aufgemacht werden...


Sub OpenWkb()
sPath = "K:\Text\MirSte\test\"
Application.ScreenUpdating = False
Application.EnableEvents = False
z = ActiveWorkbook.Name
u = 2
On Error GoTo ERRORHANDLER
If Right(sPath, 1) <> "/" Then sPath = sPath & "\"
sFile = Dir(sPath & "600z*.xls")
Do While sFile <> ""
Workbooks.Open sPath & sFile, UpdateLinks:=3
Application.Run "BLPLinkReset"
Workbooks(z).Sheets("Tabelle1").Cells(u, 1) = sPath & sFile
u = u + 1
sFile = Dir()
Loop
Application.OnTime Now + TimeSerial(0, 1, 0), "schließen"
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
Workbooks(z).Activate
End Sub

Bitte um Hilfe!
Miriam

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Miriam,
versuche mal so (Start über LOS):

Public u As Integer
Public iCounter As Integer
Public sPath As String
Dim arr As Variant
Dim sFile As String
Dim arrFiles()
Sub LOS()
u = 1
sPath = "H:\Working\Temp\"
arr = FileArray(sPath)
OpenWkb
End Sub
Sub OpenWkb()
    Application.EnableEvents = False
    On Error GoTo ERRORHANDLER
        Application.OnTime Now + TimeSerial(1, 0, 0), "schließen"
        Workbooks.Open sPath & arr(u), UpdateLinks:=3

ERRORHANDLER:
    Application.EnableEvents = True
End Sub
Sub schließen()
    ActiveWorkbook.Close savechanges:=True
    If u <> iCounter Then
        u = u + 1
        OpenWkb
    End If
End Sub
Private Function FileArray(sPath As String)
   If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
   sFile = Dir(sPath & "*.xls")
   Do While sFile <> ""
       iCounter = iCounter + 1
       ReDim Preserve arrFiles(1 To iCounter)
       arrFiles(iCounter) = sFile
       sFile = Dir()
   Loop
   FileArray = arrFiles

Code eingefügt mit Syntaxhighlighter 2.1

Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread