Instanz von excel bleibt offen -- Hilfe !!
excel
untenstehender code öffnet von access aus ne Excelvorlage, esportiert werte aus der db und speichert die excelvorlage neu.
funktioniert beim ersten aufruf korrekt, allerdings wird eine Excelinstanz nicht geschlossen. Selbst mit oExcel_app.quit bleibt im Taskmanager noch ein excel.exe prozess offen. Beim 2ten durchlauf haben die seitenvariablen ipages usw immer noch die ersten werte, weshalb dann gerade die doppelte seitenangabe in der neuen mappe angezeigt wird. Was hab ich übersehn zu schließen ?
Und warum kommt manchmal fehler 462 der remoteserver reagiert net mehr ?
gruss, sandy
Option Compare Database
Option Explicit
Const cMaskeLaga = "test.xls"
Private oExcel_App As Object
Private oExcel_Mappe As Object
Private oExcel_sheet As Object
Dim sMasterPfad As String, sMaskenPfad As String, i, n, pagecount, icount, ipages As Integer
Private Function Excel_connect() As Boolean
Excel_connect = True
On Error GoTo OpenError
Set oExcel_App = GetObject(Class:="Excel.Application") ' Gucken ob Excel offen ist
On Error GoTo 0 ' In Zukunft wieder in den Debugger laufen
'oExcel_App.Visible = True ' Wenns nicht war, trotzdem dann sichtbar
function_end:
Excel_connect = False
Exit Function
OpenError: ' Excel war nicht offen, also dann bitte öffnen
On Error GoTo CreateError
Set oExcel_App = CreateObject(Class:="Excel.Application")
oExcel_App.Visible = True
CreateError:
'Excel ist nicht vorhanden
'MsgBox "Kein Excel vorhanden"
Excel_connect = False
Resume function_end
End Function
Private Sub excelarbeit()
Excel_connect
oExcel_App.Workbooks.Open "test.xls"
Set oExcel_Mappe = oExcel_App.ActiveWorkbook
oExcel_Mappe.Sheets.Select
oExcel_Mappe.Sheets.Copy
'oExcel_Mappe.Saved = True
oExcel_Mappe.Close
Set oExcel_Mappe = oExcel_App.ActiveWorkbook
Set oExcel_sheet = oExcel_Mappe.ActiveSheet
'oExcel_App.Application.ScreenUpdating = False
For Each oExcel_sheet In Worksheets
oExcel_sheet.Select
ipages = ipages + ExecuteExcel4Macro("INDEX(GET.DOCUMENT(50),1)") 'gibt GesamtSeiten in mappe
Next oExcel_sheet
For n = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(n).Select
icount = ExecuteExcel4Macro("GET.DOCUMENT(50)") ' gibt gesamtseiten in sheet
pagecount = pagecount + ExecuteExcel4Macro("INDEX(GET.DOCUMENT(50),1)") ' gibt aktuelle seite in mappe
If n = 1 Then
Worksheets(n).PageSetup.FirstPageNumber = 1
Worksheets(n).PageSetup.LeftFooter = "blablablabla" ' erste seite anderer leftfooter
Worksheets(n).PageSetup.RightFooter = "Ort den &D" & Chr(13) & _
"Seite &P von " & ipages
Else
Worksheets(n).PageSetup.FirstPageNumber = pagecount - icount + 1
Worksheets(n).PageSetup.LeftFooter = "sososososo"
Worksheets(n).PageSetup.RightFooter = "Ort den &D" & Chr(13) & _
"Seite &P von " & ipages
End If
Next n
oExcel_App.Application.StatusBar = False
oExcel_App.Application.DisplayAlerts = False
oExcel_Mappe.SaveAs sMasterPfad & "test.xls"
oExcel_Mappe.Close
oExcel_App.Application.DisplayAlerts = True
Ausgang:
On Error Resume Next
Excel_Disconnect
Exit Sub
Fehler:
MsgBox Err.Description
Resume Ausgang
End Sub
Private Sub Excel_Disconnect()
On Error Resume Next
oExcel_App.quit
Set oExcel_sheet = Nothing
Set oExcel_Mappe = Nothing
Set oExcel_App = Nothing
End Sub
Private Function PfadDatenBank() As String
Dim sPfad As String, i As Integer, k As Integer
sPfad = CurrentDb.Name
i = InStr(1, sPfad, "\")
k = i
While i > 0
k = i
i = InStr(i + 1, sPfad, "\")
Wend
PfadDatenBank = Mid(sPfad, 1, k)
End Function