Nur bestimmte Zip-Files entpacken

Hallo Yaslaw,

da bin ich nochmal mit einer kleinen Erfolgsmeldung.

Code:
    sLw = Left(WScript.ScriptFullName, 2)
    sShDrv = "X:"
    sRoot = sLw & "\gmd"
    sBin = sRoot & "\bin"
    sData = sRoot & "\data"
    sInput = sRoot & "\input"
    sStore = sRoot & "\store"
    sCfg = sBin & "\cfg"
    sExt = sBin & "\ext"
    sLog = sBin & "\log\Events.log"
    sInC = sInput & "\coa"
    sInR = sInput & "\raw"
    sStXLS = sStore & "\xls\"
    sStZip = sStore & "\zip\"
 
'Initialize tools
    s7z = sExt & "\7z.exe"
    'sVbs = sBin & "\getData.exe"
    sVbs = sBin & "\getData.vbs"
    sHta = sBin & "\GMDevents.hta"
 
'Initialize character 34(") for CMDLine
    sQ = Chr(34)
 
'Write message
    Call Logging("start program GMD")
    WScript.Echo ("start program GMD")
 
'Initialize objects and counts
    Set oShell = CreateObject("WScript.Shell")
    Set oFso = CreateObject("Scripting.Filesystemobject")
    iCount = 0
    iFlag = 0
 
'check if shared drive is available
    If (oFSO.DriveExists(sShDrv)) Then
        iFlag = 1
        Call Logging ("shared drive " & sShDrv & " is available!")
    Else
        iFlag = 0
        Call Logging ("shared drive " & sShDrv & " not available!")
    End If
 
 
'Recognize zip files
    For Each oFile In oFso.GetFolder(sData).Files
        If LCase(oFso.GetExtensionName(oFile.Name)) = "zip" Then
            aZipParts = Split(oFso.GetBaseName(oFile.Path), " ", 2)
 
'Recognize coa and create folders
            If InStr(1, oFile.Name, "coa", vbTextCompare) > 0 Then
                sFolderOut = sQ & oFso.BuildPath(sInC, aZipParts(1)) & sQ
            Else
                sFolderOut = sQ & oFso.BuildPath(sInR, aZipParts(1)) & sQ
            End If
 
'Write message
            Call Logging("extract " & aZipParts(1) & " data from " & aZipParts(0))
 
'Extract zip files to created folders
            CmdLine = sQ & s7z & sQ & " e " & sQ & oFile.Path & sQ & " -y -o" & sFolderOut
            oShell.Run CmdLine, 0, True:  iCount = iCount + 1
        End If
        
'Write message
    Call Logging ("move " & oFile.Path & " to " & sStZip)
    
'move Zip file to \store\zip
    oFso.CopyFile oFile.Path, sStZip, true
    oFso.DeleteFile oFile.Path
            
    Next
 
'Initialize data search and export program
    If iCount = 0 Then
        'Write message
        Call Logging("zip file(s) not available")
    Else
        With oShell
            'Write message
            Call Logging("search\export data to final XLSX file(s)")
 
'Search for data and export to final XLSX files
            For Each sName In Array("xyz 400", "xyz 600", "xyz 800")
            
            sMonth = Right(aZipParts(0),2)
            sMonthEN = getMonth(MonthName(sMonth,True))
            sYear = Left (aZipParts(0),2)
            sProdName = Split(sName," ")
            sProduct = sProdName(0)
 
            Select Case Right(sProdName(1),3)
            Case 400
                sLN = "a278"
            Case 600
                sLN = "a280"
            Case 800
                sLN = "b950"
            Case Else
                Call Logging("assignment to LN not possible!")
            End Select
            sFullProdName = sProduct & " " & sLN
                
                CmdLine = sQ & sVbs & sQ & " " & sQ & oFso.BuildPath(sCfg, sName & ".ini") & sQ
                .Run CmdLine, 0, True
 
                If iFlag = 1 Then
 
'Write message
                    Call Logging ("move " & sName & ".xlsx" & " to Product data path")
 
'move Result xlsx file to Product data path                 
                    oFSO.CopyFile sStXLS & sName & ".xlsx", _
                    "X:\groups\RnS_TM\00 DnA\03-" & sYear & " Monthly\TPM\" & sFullProdName & "\" & sMonth & " - " & sMonthEN & "\Data\", True
                    oFSO.DeleteFile sStXLS & sName & ".xlsx"
 
'Write message
                    Call Logging ("move " & sName & ".zip" & " to Product data path")
 
'move Result xlsx file to Product data path             
                    oFSO.CopyFile sStZip & sYear & sMonth & " " & sName & "*.zip", _
                    "X:\groups\RnS_TM\00 DnA\03-" & sYear & " Monthly\TPM\" & sFullProdName & "\" & sMonth & " - " & sMonthEN & "\Data\Zip\", True
                    oFSO.DeleteFile sStZip & sYear & sMonth & " " & sName & "*.zip"
                End If
            Next
 
'Write message
    Call Logging("end program GMD")
    WScript.Echo ("end program GMD")
 
'Signal end of program and show log file
                .Run "cmd /c @echo " & Chr(7), 0, False
                .Run sQ & sHta & sQ, 0, False
        End With
    End If
 
'Deallocate objects and exit program
    Set oFso = Nothing
    Set oShell = Nothing
    WScript.Quit
 
'Function to convert MonthName from GER to EN
Function getMonth(sMonthEN)
    Select Case sMonthEN
    Case "Mrz"
        getMonth = "Mar"
    Case "Mai"
        getMonth = "May"    
    Case "Okt"
        getMonth = "Oct"
    Case "Dez"
        getMonth = "Dec"
    Case Else
        getMonth = sMonthEN
    End Select
End Function
 
'Function to create and write log-file
Function Logging(ByRef sMsg)
    Dim oFSO, EventMSG
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set EventMSG = oFSO.OpenTextFile(sLog,8,true)
    EventMSG.WriteLine "[" & Now & "] [FlowControl] [Event: " & sMsg & "]"
    EventMSG.Close
    Set EventMSG = Nothing
End Function

Möglicherweise mache ich da ein paar Sachen über die Brust ins Auge, aber bis dahein funktioniert das ganze ohne Problem :)

Nun würde ich dem ganzen noch gerne die Krone aufsetzen und den kompletten ablauf in eine Do - Loop Schleife setzen.
Aktuell funktioniert das wenn ich X Zip-Dateien im Ordner \Data habe die alle mit den gleichen Zeichen beginnen (z.B. 4 Zips beginnend mit 1310).
Danach folgen weitere Zeichen, die sind für die Loops aber nicht entscheidend.
In diesem Fall gehören die 4 Dateien zu einem Prozess. Die 13 steht für YY, die 10 für MM.
Nun möchte ich idealerweise im Data-Ordner auch gleich (soweit vorhanden) 1311, 1312, 1401, 1402, usw. ablegen können.
Aktuell werden alle Zip-Dateien verarbeitet die erfindet. Das würde ziemliches Chaos geben - ich benötige zwingend eine Trennung.
Wie kann man dem Script beibringen, das es solange immer wieder neu durchlaufen werden soll wie Zip-Dateien im Ordner sind, diese jedoch in Gruppen abgearbeitet werden müssen (erst alle 1310 - Loop - dann alle 1311 - Loop - usw.)?

LG
amn.ssy
 
Zurück