Hilfe bei Worbooks.Close
17.08.2006 12:00:12
Torsten
ich habe ein Problem mit Workbooks.Close. Der nachfolgende Code - der im übrigen unter Excel2000 durchgelaufen ist - steigt an der Stelle "Workbooks("IT_Budget_2007.xls").Close , True" regelmäßig aus und führt bei Excel zum kompletten Abbruch (Meldung: Die Methode 'Close' für das Objekt_Workbook ist fehlgeschlagen). Ich habe bereits mehreres probiert, aber nichts hat funktioniert. Mit dem Code wird eine Datei unter einem neuen Namen gespeichert und anschließend direkt geöffnet, wobei die Original-Datei ebenfalls geöffnet bleibt, weil aus ihr heraus der Code ja abläuft. Anschließend werden in der Kopie-Datei einige Aktionen vorgenommen (WS löschen, Module entfernen, cmb_Buttons gelöscht) bevor die SendMail-Funktion ausgeführt wird.
Das alles funktioniert auch einwandfrei (auch die Mail wird versandt), bis die Kopie-Datei geschlossen werden soll.
Private Sub cmb_SENDM_Click()
If Sheets("EDP").Range("N6").Value = "" Then
If MsgBox("Soll die Datei jetzt gesendet werden?", vbYesNo) = vbYes Then
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs "C:\Dokumente und Einstellungen\IT_Budget_2007.xls"
'Hier wird IT_Budget_2007.xls zum ActiveWorkbook !
Workbooks.Open "C:\Dokumente und Einstellungen\IT_Budget_2007.xls"
'Es werden Makros beim Öffnen der Datei gestartet.
'Diese müssen zunächst beendet werden!
ActiveWorkbook.RunAutoMacros xlAutoClose
'Ersetzen Formeln durch Werte
ActiveWorkbook.Sheets("EDP").Unprotect Password:="maze"
With ActiveWorkbook.Sheets("EDP").Range("B1:N71")
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
'Löschen aller WS außer WS("EDP")
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "EDP" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Dim wks As Worksheet
Dim cb As Object
Set wks = ActiveSheet
'Löschen des Codes aus "Diese Arbeitsmappe"
With ActiveWorkbook.VBProject
With .VBComponents("DieseArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
End With
'Löschen aller cmb_Buttons im aktiven WS
For Each cb In wks.OLEObjects
If TypeName(cb.Object) = "CommandButton" Then
cb.Delete
End If
Next cb
'Löscht Module im aktiven WB
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("modPrintForm1")
.VBComponents.Remove .VBComponents("modPrintForm1NB")
End With
ActiveWorkbook.Sheets("EDP").Protect Password:="maze"
ActiveWorkbook.Sheets("EDP").Range("A1").Select
ActiveWorkbook.Save
Dim dummy As Variant
Dim irow As Integer
dummy = SendNotesMail("IT_Bedarf 2007 GWS / " & Sheets("EDP").Range("D3").Value
_ & " / " & Sheets("EDP").Range("N3").Value, _"C:\Dokumente und Einstellungen\IT_Budget_2007.xls", "Mailaddresse", "", True)
ActiveWorkbook.Save
' Umschalten auf das ursprüngliche Workbook
wb1.Activate
' Löschen der temporären Datei
Application.DisplayAlerts = False
Workbooks("IT_Budget_2007.xls").Close , True
Kill "C:\Dokumente und Einstellungen\IT_Budget_2007.xls"
With Worksheets("PROTOC") 'Protokoll
irow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Unprotect "maze"
.Cells(irow, 2).Value = Date
.Cells(irow, 3).Value = Time
.Cells(irow, 4).Value = Environ("Username")
.Protect "maze"
End With
Application.DisplayAlerts = True
MsgBox ("Die Datei wurde gesendet")
Sheets("PROTOC").Select
Application.ScreenUpdating = True
Else
End If
Else
MsgBox ("Bitte korrigieren Sie zuerst die Fehler!"), vbCritical, "Hinweis von Finance"
End If
End Sub
Ich wäre Euch sehr dankbar, wenn Ihr mir weiterhelfen könntet.
Gruß
Torsten