gctools/excel/convert.xls.vb

Option Explicit

Private Declare Function GetCommandLine& Lib "kernel32" _
Alias "GetCommandLineA" ()

Private Declare Function lstrlen Lib "kernel32" ( _
ByVal str As Long) As Long

Private Declare Function lstrcpy Lib "kernel32" ( _
ByVal dest As String, _
ByVal src As Long) As Long

Private Function Befehlsparameter(plngAscii As Long) As String
    Dim lngAnzahl&, strName$
    lngAnzahl = lstrlen(plngAscii)
    strName = String(lngAnzahl, 0)
    lstrcpy strName, plngAscii
    If InStr(1, strName, Chr(0)) <> 0 Then
        strName = Left$(strName, InStr(1, strName, Chr(0)) - 1)
    End If
    Befehlsparameter = strName
End Function

Private Function WertVonFlag(liste As String, flag As String) As String
    Dim wert As String
    wert = Right$(liste, Len(liste) - 2 - InStr(1, LCase(liste), flag))
    wert = Left$(wert, InStr(1, wert, "/") - 1)
    WertVonFlag = wert
End Function

Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    
    Dim datei As String
    datei = WertVonFlag(Befehlsparameter(GetCommandLine()), "/e/")
        
    If datei <> "" And Mid(datei, 1, 1) <> ":" Then
        Workflow datei
        Application.Quit
    End If
    
    Application.DisplayAlerts = True
End Sub



Sub Workflow(folder As String)
    Dim file As String

    file = dir(folder & "\*.xls")
    Do While file <> ""
        If file Like "*xls" Then
            Workbooks.Open Filename:=folder + "\" + file
            ActiveWorkbook.SaveAs Filename:=folder + "\" + file, FileFormat:=xlExcel8
            ActiveWorkbook.SaveAs Filename:=folder + "\" + file + "x", FileFormat:=xlOpenXMLWorkbook
            ActiveWorkbook.Close
        End If
        file = dir
    Loop
    Application.Quit
End Sub


Sub Macro1()
    Workflow "D:\Projekte\GlobalCube\makro_MVC\Fibu"
End Sub