Excel automatisch starten und am Ende schliessen

Public workdir, savedir, perffile, defaultfile, myworkbook, protocol, _
       datestamp, filebegin, defaulthost, db_server, _
       overview, htmlsavedir As String
Public debug_level As Integer
' App Server Array  
Public app_server(1 To 50, 1 To 4) As Variant


Sub auswertung()
On Error GoTo fehler

' Bildschrimausgabe ausknipsen  
Application.ScreenUpdating = False

' Deklarationen und Variablen  
' ---------------------------------------------------  
Dim zaehler As Integer

workdir = get_param("workdir")  
savedir = get_param("savedir")  
htmlsavedir = get_param("htmlsavedir")  
' Checken der Verzeichnisse  
On Error GoTo dir_error
ChDir savedir
ChDir htmlsavedir
ChDir workdir
On Error GoTo 0
protocol = get_param("protocol_file")  
protocol = workdir & protocol
debug_level = get_param("debug_level")  
filebegin = get_param("filebegin")  
db_server = get_param("db_server")  
overview = get_param("overview")  
app_diagrams = get_param("app_diagrams")  
'Merke eigenes Workbook  
myworkbook = ActiveWorkbook.name

' Verhinderung des Abbruchs (Schutzverletzung)  
' Öffnen und Schließen der Benutzerdefinierten Charts  
On Error Resume Next
Workbooks.Open filename:=workdir & "XL8GALRY.XLS", ReadOnly:=True  
If Not Err.Number = 1004 Then
ActiveWorkbook.Close SaveChanges:=False
End If
On Error GoTo 0

'On Error GoTo fehler  
' Datum für verschiedene Plattformen  
datum = Date - 1
If Len(datum) = 10 Then
   datestamp = Right(datum, 4) & Mid(datum, 4, 2) & Left(datum, 2)
ElseIf Len(datum) = 8 Then
   datestamp = "20" & Right(datum, 2) & Mid(datum, 4, 2) & Left(datum, 2)  
Else
   datestamp = ""  
End If

' App Server Array  
' 1. Dimension: verschiedene App Server (max. 50!)  
' 2. Dimension: 1 App_server wie in SM51 (HOST_SID_SYSNR)  
'               2 HOST  
'               3 SID  
'               4 SYSNR  
Dim sheetname As String
sheetname = ActiveSheet.name
ActiveWorkbook.Sheets("Configuration").Activate  
zaehler = 1
For i = 10 To 1000
   If Cells(i, 1).Value = "app_server" Then  
      app_server(zaehler, 1) = Cells(i, 2).Value
      ' aufdröseln  
      pos1 = InStr(1, app_server(zaehler, 1), "_", vbTextCompare)  
      pos2 = InStr(pos1 + 1, app_server(zaehler, 1), "_", vbTextCompare)  
      app_server(zaehler, 2) = Left(app_server(zaehler, 1), pos1 - 1)
      app_server(zaehler, 3) = Mid(app_server(zaehler, 1), pos1 + 1, 3)
      app_server(zaehler, 4) = Right(app_server(zaehler, 1), Len(app_server(zaehler, 1)) - pos2)
      'MsgBox (app_server(zaehler, 1) & vbCr & _  
              app_server(zaehler, 2) & vbCr & _
              app_server(zaehler, 3) & vbCr & _
              app_server(zaehler, 4) & vbCr)
      zaehler = zaehler + 1
   End If
Next i
ActiveWorkbook.Sheets(sheetname).Activate
    ' Anzeige der App-Server  
    ' i = 1  
    ' While Not app_server(i, 1) = ""  
    '    MsgBox (app_server(i, 1))  
    '    i = i + 1  
    ' Wend  
' ENDE App Server Array  

' Auswertungsdatum festlegen  
datestamp2 = Date - 1
datestamp = Format(datestamp2, "YYYYMMDD")  
If datestamp = "" Then 'Abbruch  
   Exit Sub
End If
            


' ---------------------------------------------------  
' M A I N  
' ---------------------------------------------------  
' hier geht's mit der Schleife los  
proto ("Start Loop")  
i = 1
While Not app_server(i, 1) = ""  
    ' Arbeits Vars  
    datasheet = app_server(i, 1)
    perffile = filebegin & "." & app_server(i, 1) & "." & datestamp  
    
    proto ("new_sheet")  
    new_sheet (datasheet)
    proto ("open_perf_file")  
    okcode = open_perf_file(workdir & perffile)
    If okcode = "OK" Then  
        proto ("clear_perf_file")  
        clear_perf_file (perffile)
        Workbooks(myworkbook).Activate
        proto ("move_table_to_auswertung")  
        move_table_to_auswertung (perffile)
        Application.DisplayAlerts = False
        Workbooks(perffile).Close
        Application.DisplayAlerts = True
        proto ("create_header")  
        create_header (datasheet)
        If app_diagrams = "y" Or app_diagrams = "j" Then  
           proto ("create_diagram")  
           create_diagramm (datasheet)
        End If
    End If
    i = i + 1
Wend
proto ("Zusammenfassung erstellen")  
create_overview (overview)
create_overview_diagramm (overview)
proto ("export_dia_to_internet")  
Call export_dia_to_internet((myworkbook), (overview))
proto ("move_worksheet")  
move_worksheets

'Aktiviere eigenes Workbook  
'Workbooks(myworkbook).Activate  
proto ("ENDE")  

' Bildschrimausgabe anknipsen  
Application.ScreenUpdating = True

Exit Sub
fehler:
MsgBox ("Fehler " & Err & " aufgetreten!!!")  
proto ("Fehler " & Err & " aufgetreten!!!")  
Exit Sub

dir_error:
'MsgBox ("Fehler " & Err & " aufgetreten!!!")  
Mldg = Chr(13) & Err.Description & vbCr _
        & "Bitte prüfen Sie die Konfiguration der Verzeichnisse!"  
MsgBox Mldg, , "Fehler # " & Str(Err.Number) & " wurde ausgelöst"  
Exit Sub


End Sub

Sub ftp_to_webserver()
Application.ScreenUpdating = False
Dim exportwb, exportsh, files As String

exportwb = ActiveWorkbook.name
exportsh = ActiveSheet.name
wbz = 0
For i = 1 To Workbooks.Count
    If Left(Workbooks(i).name, 10) = "Auswertung" Then  
       myworkbook = Workbooks(i).name
       wbz = wbz + 1
    End If
Next i
If wbz <> 1 Then
   MsgBox ("FEHLER: Die Exceldatei, die die Makros enthält, ist nicht oder mehrfach geöffnet !!!" & vbCr _  
         & "(Hinweis: die Datei MUSS mit >Auswertung< beginnen) ")  
   Exit Sub
End If


Workbooks(myworkbook).Activate

webserver_ip = get_param("webserver_ip")  
webserver_account = get_param("webserver_account")  
webserver_passwd = get_param("webserver_passwd")  
webserver_dir = get_param("webserver_dir")  
htmlsavedir = get_param("htmlsavedir")  
htmllocaldir = Left(htmlsavedir, Len(htmlsavedir) - 1)



       
    
Call export_dia_to_internet((exportwb), (exportsh))
Workbooks(myworkbook).Activate


htfile = htmlsavedir & Left(exportwb, (Len(exportwb) - 4)) & ".html"  
files = Left(exportwb, (Len(exportwb) - 4)) & "*"  

extra_text = add_text_to_html(extra_text)
If extra_text <> "" Then  
   Call edit_html_page(extra_text, htfile)
End If

Call ftp(webserver_ip, files, htmllocaldir, webserver_dir, webserver_account, webserver_passwd, rc)
If rc Then
   MsgBox ("FTP Übertragung erfolgreich beendet!")  
Else
   MsgBox ("Fehler beim FTP!")  
End If

Application.ScreenUpdating = True

End Sub