AW: Screencache, Überlauf bei längerem Script?
10.11.2004 00:13:37
Bjoern
Huhu Ramses,
einmal mehr Danke für Deine schnelle AW. Allerdings wirst Du mit dem relativ langen, aber ziemlich unspektakulären Code wenig anfangen können, weil er eben der Steuerung einer Großrechneranwendung dient. Nachstehend der eigentliche Programm-Code, den Code zum Ansprechen der drittanwendung habe ich mal der Übersichtlichkeit ausgelassen, zumal Du ihn ohnehin nicht testen kannst und er sicher nicht verantwortlich für die Probleme (treten auch bei anderem Code auf, eben bei Serien-Mailing, etc). Das Problem hängt sicher mit irgendeinem Überlauf zusammen...nur eben welchem? Wenn Du ein Paar Idee zum Freigeben von Speicher, etc hättest, wäre das sicher bereits ein guter Ansatz. Nochmals Danke!
Sub Main()
' Das Hauptsystemobjekt abrufen
Dim Sessions As Object
Dim System As Object
Set System = CreateObject("Großrechner.System") ' Ruft das Systemobjekt ab.
Set Sessions = System.Sessions
' Den Wert der Standard-Wartezeitüberschreitung einstellen
g_HostSettleTime = 50 ' Millisekunden
OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If
' Das erforderliche Session-Objekt abrufen
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
' VB-Code
With Sess0.Screen
Set VO-STATISTIK = Sess0.Screen.Area(1, 2, 1, 6)
Dim Durchlauf As Integer
Durchlauf = 1
I = 4
z = I
n = 2
Spalte = 7
Schleife:
'IN VO-STATISTIK
.MoveTo 2, 45
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
'MsgBox "halt"
.MoveTo 10, 45
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
If (Durchlauf = 1) Or (Durchlauf = 3) Then
.MoveTo 17, 15
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
Else
.MoveTo 18, 15
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
End If
.MoveTo 30, 15
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 12, 7
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 5, 26
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
Dim Zeitzeile As Integer
Zeitzeile = 13 + Format(Date, "mm")
If Trim(.Area(Zeitzeile, 42, Zeitzeile, 46)) = "" Then
Zeitzeile = 13 + Format(Date, "mm") - 1
If Trim(.Area(Zeitzeile, 42, Zeitzeile, 46)) = "" Then
MsgBox "Fehler bei Datum aufgetreten, bitte prüfen."
Exit Sub
End If
End If
.MoveTo Zeitzeile, 42
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 5, 64
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
If (Durchlauf = 1) Or (Durchlauf = 2) Then
signal
MsgBox "Bitte Zeitraum wählen"
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
If Durchlauf = 3 Then
signal
MsgBox "Bitte Vorjahres-Zeitraum wählen"
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Set Ergebnis = .Area(19, 6, 29, 75)
Set Endzeile = .Area(29, 7, 29, 8)
Set AtBottom = .Area(3, 3, 3, 3)
Set Endnummer = .Area(29, 7, 29, 8)
Set BDFeld = .Area(9, 22, 9, 31)
Set ZeitFeld = .Area(12, 5, 12, 15)
Set Sparte = .Area(6, 15, 6, 30)
Set Bestandsaenderung = .Area(19, 30, 19, 40)
Set Bestandsaktion = .Area(20, 30, 20, 40)
Set Anpassung = .Area(21, 30, 21, 40)
Set Zuwachs = .Area(17, 30, 17, 40)
Set Neugeschaeft = .Area(19, 30, 19, 40)
Set BStorno = .Area(17, 30, 17, 40)
Set Neugeschaeft = .Area(19, 30, 19, 40)
Set BStorno = .Area(21, 30, 21, 40)
Set SAbgang = .Area(22, 30, 22, 40)
Set Steigerung = .Area(19, 63, 19, 69)
Set Kontrollwert = .Area(17, 6, 17, 20)
Set Aenderung = .Area(20, 30, 20, 40)
Set Auswertung_am = .Area(1, 59, 1, 68)
Set stand = .Area(1, 34, 1, 43)
Set SteigerungAenderung = .Area(20, 62, 20, 71)
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Ergebnis").Select
If Durchlauf = 1 Then
ThisWorkbook.Sheets("Produktion").Range("Sparte") = Trim(Sparte)
[Zeitraum] = ZeitFeld
ThisWorkbook.Sheets(3).Range("Erstelldatum") = Auswertung_am
ThisWorkbook.Sheets(3).Range("Stand") = stand
Sheets(3).Select
ThisWorkbook.Sheets("Ergebnis").Range("Wertfeld").ClearContents
End If
Do Until ThisWorkbook.Sheets("Abfrage").Cells(I, 1) = ""
.MoveTo 9, 22
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 13, 14
BD = ThisWorkbook.Sheets("Abfrage").Cells(I, 1)
.SendKeys (AU & " " & "<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 30, 10
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
If Trim(Kontrollwert) = "Bestandszuwachs" Then
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte - 1) = (BDFeld)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte) = (Zuwachs)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 1) = (Neugeschaeft)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 2) = (BStorno)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 3) = (SAbgang)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 7) = (Steigerung)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 9) = (Aenderung)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 10) = (SteigerungAenderung)
Else
MsgBox "VO-Statistik zeigt nicht Bestandszuwachs an! Script bricht ab."
.SendKeys ("<Reset>")
Application.ScreenUpdating = True
Exit Sub
End If
.MoveTo 20, 10
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
If Trim(Kontrollwert) = "Änderung" Then
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 4) = (Bestandsaenderung)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 5) = (Bestandsaktion)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 6) = (Anpassung)
ThisWorkbook.Sheets("Ergebnis").Cells(z, Spalte + 8) = (Steigerung)
Else
MsgBox "VO-Statistik zeigt nicht Änderung an! Script bricht ab."
.SendKeys ("<Reset>")
Application.ScreenUpdating = True
Exit Sub
End If
.MoveTo 2, 12
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
.MoveTo 5, 12
.SendKeys ("<Enter>")
.WaitHostQuiet (g_HostSettleTime)
I = I + 1
z = z + 1
Loop
If Durchlauf < 3 Then
Durchlauf = Durchlauf + 1
I = 4
GoTo Schleife:
End If
Range("B6").Select
Sheets("Produktion").Copy
ChDir ThisWorkbook.Path & "\VOC-Produktion"
Dim name As Variant
ZeitFeld = SuchenUndErsetzen(ZeitFeld, "-", " bis ")
ZeitFeld = SuchenUndErsetzen(ZeitFeld, "/", "-")
name = Trim(Sparte) & "-Produktion VOC, Zeitraum " & Trim(ZeitFeld) & ", zum " & stand & " Abfrage vom " & Date & " " & Format(Time, "hh.mm") & ".xls"
Dim Datei As Variant
Datei = ThisWorkbook.Path & "\VOC-Produktion\" & name
Workbooks(Workbooks.Count).SaveAs FileName:= _
Datei _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("B10:AZ33").Select
Selection.Sort Key1:=Range("AB8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B35:AZ38").Select
Selection.Sort Key1:=Range("AB33"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B7").Select
ActiveWorkbook.Save
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add("abc@xyp.de")
objOutlookRecip.Type = olTo
Set objOutlookAttach = .Attachments.Add(Datei)
.Subject = "Aktuelle Auswertung VO-STATISTIK vom " & Date
.HTMLBody = "<BODY style='text-align:justify; font-family: Verdana, Arial, Helvetica, sans-serif, arial; bgColor=white'>" & _
"Text......" & _
"</BODY></HTML>"
.Save
End With
Application.ScreenUpdating = True
signal
MsgBox "Abfrage durchgeführt"
End With
System.TimeoutValue = OldSystemTimeout
End Sub