[Excel] VBA: CSV Import, je Dateiname neues Tabelleblatt

[amn.ssy]

Hallo,

mit Excel-VBA beschäftige ich mich erst seit kurzem und habe nun gleich zum Beginn einen "Hammer" auf'm Tisch bei dem ich hier auf kompetente Hilfe hoffe.
Zum Backgound: Via in einer Batch verschachtelten Tools und ein wenig VBS (für Regex) suche ich in unterschiedlichen PDF-Dateien nach Begriffe und den dazu gehörenden Werten. Dies klappt auch sehr gut bis dahin, daß mir für jede PDF-Datei eine CSV erstellt wird, die zur besseren Unterscheidung auch gleich den Produktnamen als Dateinamen erhält.
Alle Dateien werden in einem Ordner gespeichert (eine Verteilung auf Unterordner ist angedacht.)
Ich habe mir nun aus den weiten des Netzes ein weiteres Tool gebaut und erweitert um diese CSV-Dateien in Excel einzulesen, zu transponieren und als xslx abzuspeichern. Die dazu gehörige xltm rufe ich in meiner Batch-Datei via call auf.
Nach getaner Arbeit soll sich das Excel-Makro komplett schließen und zur Batch zurückkehren.

Mein bisheriger Code sieht zur Zeit so aus:
Arbeitsmappe:

Sub Workbook_Open() 

    Dim iRet As Integer 
    Dim strPrompt As String 
    Dim strTitle As String 
  
    strPrompt = "Jetzt Durchführen, OK?" 
  
    strTitle = "CSV-Import" 
  
    iRet = MsgBox(strPrompt, vbOKCancel, strTitle) 
  
    If iRet = vbOK Then 
    
        CSV_Import 
    
    'Else 
    
        'ActiveWorkbook.Close 
        'Application.Quit 
        
    End If 

End Sub

Modul1:

Sub CSV_Import() 
    Dim sInPfad As String 
    Dim sOutPfad As String 
    Dim sDatei As String 
    Dim iFF As Integer 
    Dim lLZ As Long 
    Dim sTmp As String 
    Dim vntTmp As Variant 
    
    sInPfad = "C:\PDF2CSV\Output\" 
    sOutPfad = "C:\PDF2CSV\Results\" 
    
    sDatei = Dir(sInPfad & "*.csv") 
            
    Do While sDatei <> "" 
        lLZ = lLZ + 1 
        iFF = FreeFile() 
        Open sInPfad & sDatei For Input As iFF 
        sTmp = Input(LOF(iFF), iFF) 
        Close iFF 
        With WorksheetFunction 
            If lLZ = 1 Then 
                vntTmp = TextSplitten(sTmp, True) 
                Tabelle1.Cells(lLZ, 1).Resize(, UBound(vntTmp) + 1) = .Transpose(.Transpose(vntTmp)) 
                lLZ = lLZ + 1 
            End If 
            vntTmp = TextSplitten(sTmp) 
            Tabelle1.Cells(lLZ, 1).Resize(, UBound(vntTmp) + 1) = .Transpose(.Transpose(vntTmp)) 
        End With 
        sDatei = Dir 
    Loop 
    
    Save_xlsx ActiveWorkbook, sOutPfad & Format(Now, "dd_mm_yyyy_hhmm") & ".xlsx" 
    
    ActiveWorkbook.Saved = True 
    ActiveWorkbook.Close 
    Application.Quit 
          
End Sub 

Sub Save_xlsx(Wb As Workbook, Name As String) 
    
  Dim newWb As Workbook 
  Dim objVBComp As Object 
  
  Wb.Sheets.Copy 
  
  Set newWb = ActiveWorkbook 
  
  With newWb 
    With .VBProject 
      For Each objVBComp In .vbcomponents 
        If objVBComp.Type = 100 Then 
          With .vbcomponents(objVBComp.Name).CodeModule 
            .DeleteLines 1, .CountOfLines 
          End With 
        End If 
      Next 
    End With 
    .SaveAs Filename:=Name 
    .Close 
  End With 
  Set newWb = Nothing 

End Sub 

Function TextSplitten(sIN, Optional blnHeader As Boolean) 
    Dim i As Long 
    Dim avntA As Variant 
    
    avntA = Split(sIN, vbCrLf) 
    
    If blnHeader Then 
        For i = 0 To UBound(avntA) 
            If InStr(avntA(i), ";") Then _ 
            avntA(i) = Trim$(Left$(avntA(i), InStr(avntA(i), ";") - 1)) 
        Next 
    Else 
        For i = 0 To UBound(avntA) 
            avntA(i) = Trim$(Mid$(avntA(i), InStr(avntA(i), ";") + 1)) 
        Next 
    End If 
    TextSplitten = avntA 
End Function

Im ersten Schritt würde ich nun gerne erreichen, daß für jeden Produktnamen (die ersten 6 Zeichen des Dateinamen (ohne Endung)) ein entsprechendes Tabellenblatt angelegt wird.
Beispiel: abc123...csv => Worksheet.name=abc123, bcd234...csv => Worksheet.name=bcd234, usw.
Da die CSV-Dateien i.d.R. bereits nach Namen sortiert sind sollte das Makro auch nicht ständig zwischen den einzelnen Tabellen hin und her springen müßen, sondern nur einen neuen Tabellennamen anlegen und dort hinein transponieren wenn sich der Dateinamen ändert.
Wie umfangreich wäre einen Anpassung des Codes wenn ich mich mittelfristig entschließen sollte die CSV-Dateien gleich auf entsprechende Unterordner zu verteilen? Kann man auch in einem Arbeitsgang die einzelnen Unterorder durchlaufen?
Und eine allerletzte Frage in diesem Zusammenhang:
Woran liegt es, daß Excel sich nach dem das Makro durchgelaufen ist nicht komplett schließt? Excel bleibt ohne Worksheet offen und muß über's X geschlossen werden.

LG
opiwahn

 

[Drogist]

Hallo,

zugegeben, ich habe nur einen Teil deines Beitrages gelesen. War etwas anstrengend ...
Ich kann mir aber vorstellen, dass du hier einen Lösungsansatz findest.