Neues VBA Projekt mit mehreren Optionen

[Pr3d4tor]

Guten Morgen zusammen,

nach dem mein letztes Projekt durch Eure mithilfe abgeschlossen werden konnte, sitze ich nun an einem weiteren Teil vom gesamten Projekt. Vorab vielleicht erstmal die Info warum ich mich versuche dadurch zu kämpfen
und was am Ende rauskommen sollen.

Ich bekomme mehrere CSV Datei per Mail. Diese speichere ich in einem Temp-Ordner ab und öffne sie
mit Excel um dort dann die Zeilen 4-61 zu löschen. In der dritten Spalte befinden sich Zahlen, daher wähle ich die komplette Spalte aus und ändere das Format auf Zahl und korrigiere um 2 stellen nach hinten.

Abschließend wird die Datei in einem anderen Ordner zu Weiterverarbeitung wieder als CSV mit speziellem Namen gespeichert. Die Schritte möchte ich mir nun ersparen um auch eventuelle Fehler durch Unaufmerksamkeit zu vermeiden.

Am liebsten wäre es mir ja, wenn nach einem Klick auf einen Button, die zuletzt Gespeicherte bzw. Aktuellste Datei in einem Standard Ordner gesucht wird. Sie anschließend im "Hintergrund" geöffnet und wie oben beschrieben "Editiert" wird und Abschließend gespeichert wird. Hier allerdings mit einer Abfrage und einem vorgegebenen Namen in einem festgelegten Ordner und dem Datum und der Uhrzeit im Dateinamen.

Im Original lautet der Dateiname immer:
adwfwm_adhoc_result_20210212074709 und muss in
adwfwm_GBCVTAACE_cvt08_DATUMUHRZEIT geändert werden.
Allerdings ändert sich hierbei immer das _cvtXX_ daher müsste hier die Abfrage beim Speichern rein.

Da meine VBA Kenntnisse eher gegen Null gehen habe ich bisher folgendes hinbekommen:
Mit dem nun folgendem Code, den ich gefunden und umgebaut habe, kann ich schonmal per Button eine CSV öffnen
und das sogar direkt in dem Format das ich brauche.

Option Explicit

Private worksheet_ As Worksheet
Private DefaultPath As String
Private csv_ As String

'================= Default-Pfad festlegen und CSV öffnen
Public Sub Import()
        
    DefaultPath = Environ("Userprofile") & "\Documents\"
    
    Set worksheet_ = ThisWorkbook.Sheets(1)
    worksheet_.UsedRange.Clear
        
        
    '//Datei auswählen
    csv_ = CsvFilePath
    If csv_ = "" Then Exit Sub
            
    '//und Daten importieren
    AddCSV
    
End Sub

Private Function CsvFilePath() As String
    Dim FileDialog_ As FileDialog
    Dim selection_ As Variant
    
    Set FileDialog_ = Application.FileDialog(msoFileDialogFilePicker)
    With FileDialog_
        .Filters.Add "CSV", "*.csv", 1
        .AllowMultiSelect = False
        .InitialFileName = DefaultPath
        
        If .Show = -1 Then
            For Each selection_ In .SelectedItems
                CsvFilePath = selection_
            Next selection_
        End If
        
    End With
    
    
    Set FileDialog_ = Nothing

End Function

Private Sub AddCSV()
    
    With worksheet_.QueryTables.Add(Connection:="TEXT;" & csv_, _
        Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Problem hierbei ist allerdings das die CSV direkt in das Arbeitsblatt importiert wird und ich es bisher nicht hinbekommen habe den Code so umzustellen das der Import in einer neuen Arbeitsmappe stattfindet.

Daher habe ich es mal mit einer anderen Variante versucht:

Option Explicit
Sub AddCSV()

Dim wb As Workbook
Dim strFileName As String
Dim strFilter As Variant

'// Datei Filter festlegen
strFilter = "Excel-Dateien(*.csv*), *.csv*"

'//Default-Pfad zum öffnen festlegen
ChDrive "C"
ChDir Environ("Userprofile") & "\Documents\"

'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)

'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFilter = False Then
    Exit Sub

Else
'** Gewählte Datei öffnen
    Workbooks.OpenText Filename:=(strFileName), _
    Origin:=65001, StartRow:=1, TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, _
    Tab:=True, Semicolon:=True, Comma:=False, Space:=False, DecimalSeparator:=".", ThousandsSeparator:=",", _
    TrailingMinusNumbers:=True, FieldInfo:=Array(Array(1, 1), Array(2, 2), Array(2, 2), Array(2, 2), Array(2, 2)), _
    Local:=True _
    
            Rows("4:4").Select
            Rows("4:61").Select
            Selection.Delete Shift:=xlUp
            Columns("C:C").Select
            Selection.NumberFormat = "0"
    Application.Dialogs(xlDialogSaveAs).Show
    ActiveWorkbook.Close

End If
End Sub

Hierbei habe ich allerdings komischerweise das Problem, dass ich die Spalte C wegen dem Zahlenformat ändern muss.
Nur verstehe ich noch nicht so ganz wieso hier das Ergebniss vom Importieren anders ist als vorher?
Außerdem habe ich es bei dem zweiten Code noch nicht hinbekommen das Dateiformat an den xlDialogSaveAs zu "hängen"...

Daher nun die Frage welche der beiden Varianten ihr Empfehlen würdet, immer mit dem Endergebniss im Hinterkopf das erreicht werden soll? Das Auswählen der Datei die geöffnet werden soll manuell zu machen wäre ja noch Okay. Aber wie bekomme ich es hin das mir beim Speichern das CSV Format nicht flöten geht und direkt der Dateiname inkl. Datum und Uhrzeit vorgeben wird und man lediglich das _cvtXX_ ändern muss?

Hoffe ihr könnt mir auch hierbei weiterhelfen denn im Moment gehen mir ein wenig die Ideen aus.
Oder ich brauch einfach ne Pause


Danke schonmal und allen einen schönes Wochenende.

VG

 

[Pr3d4tor]

Guten Morgen,

mittlerweile habe ich rausgefunden das ma wohl doch über "QueryTables.Add" das ganze direkt in ein neues Blatt oder auch eine neue Mappe importieren kann.

Allerdings komme ich damit leider noch nicht so ganz klar :-(
Im Moment versuche ich folgendes (Anhand der Infos die ich finden konnte) zum Laufen zu bringen:

Private Sub AddCSV()

    Dim origWb As Workbook
        origWb = ActiveWorkbook.Name
    
    Dim newWB As Workbook
    Set newWB = Workbook.Add
    newWB = ActiveWorkbook.Name
    
    With Workbook(newWB).worksheet_.QueryTables.Add(Connection:="TEXT;" & csv_, _
        Destination:=Workbook(newWB).WorkSheet(Tabelle1) & Range("A1"))
        .Name = Name
        .FieldNames = True
        '*usw

Wobei ich gestehen muss das ich den Teil mit ActiveWorkbook.Name aus einem anderen Beispiel habe und noch nicht ganz raffe wofür das .Name steht.

Jedenfalls bekomme ich mit dem obrigen Code immer die Meldung das für Workbook.Add keine Variable definiert ist.


VG und einen schönen Sonntag

 

[Pr3d4tor]

UPDATE:

Das Erstellen/öffnen einer neuen Arbeitsmappe klappt mittlerweile aber ich raffs immer noch nicht wie ich die Daten dorthin bekomme :-(

Hab nun wieder einiges durch aber es gibt immer wieder einen Fehler.
Aktuell sieht mein Code so aus:

Private Sub AddCSV()
    
    Dim origWb As Workbook
        Set origWb = ActiveWorkbook
    
    Dim newWb As Workbook
    Set newWb = Workbooks.Add
    
    newWb = ActiveWorkbook.Name
    With ActiveWorkbook(newWb).worksheets_.QueryTables.Add(Connection:="TEXT;" & csv_, _
        Destination:=ActiveWorkbook(newWb).Worksheets(Tabelle1).Range("A1"))
        .Name = ""
   '.
    '*usw