VBA-Code für Dateiname beim Speichern teilweise vorgegeben,teilweise Inputbox

Pr3d4tor

Mitglied
Hallo,

bin auf der Suche nach jemanden der mir mal einen Code für folgende Aufgabe zur Verfügung stellt.

Das meiste von meinem Grundgerüst habe ich mittlerweile alleine fertiggestellt, jedoch komm ich jetzt alleine nicht weiter.
Ich benötige einen Code der folgendes ermöglicht:

Die CSV Datei die im per VBA importiere haben im Grunde alle den selben Aufbau im Bezug auf den Dateinamen.
Nun würde ich es gerne so hinbekommen das der Name beim Speichern mit "ActiveWorkbook.SaveAs Filename:=" wie folgt zusammen setzt.

Windowsbenutzername_GBCVTAACE_cvtXX_Jahr,Monat,Tag,Stunde,Minute,Sekunde und als standard Vorgabe genutzt wird.
z.B.: hanswurst_GBCVTAACE_cvt02_20210212011448

Da sich allerdings bei jeder Datei das _cvtXX_ ändert (und leider nicht in Reihenfolge) möchte ich nun dass sich das Script
vorm Abspeichern mit einer Inputbox-Function meldet, der komplette Dateiname vorgegeben wird und der Benutzer lediglich
das _cvtXX_ angeben/ändern kann und die Datei dann entsprechende der Eingabe gespeichert wird.

Ist sowas machbar? und wenn ja wie muss der Code dazu aussehen?
Den Pfad habe ich so Angegeben:

Dim strPfad As String
strPfad = DefaultPath = Environ("Userprofile") & "\Documents\"

Hoffe es findet sich jemand der Mitleid hat und mir den passende Code dafür zusammenbaut ;-)


VG
 

Zvoni

Erfahrenes Mitglied
strUser = Environ("USERNAME")

Was das ändern von cvtXX angeht: Würde keine Inputbox nehmen, sondern eine eigene UserForm, da du in dem Fall das ändern in "Echtzeit" anzeigen lassen kannst, da der ganze Code sich in der Userform abspielt (Stichwort: KeyUp- bzw. KeyPress-Ereignis)
 

Pr3d4tor

Mitglied
Hmm Okay, werde ich mir mal anschauen.

Ich denke aber ich gehe richig davon aus das ich den Name für die Aktion komplett zerlegen muss?
Also quasi: ActiveWorkbook.SaveAs Filename:=Pfad & strUser & '_' & "GBCVTAACE_" & "Userform" & '_' & Date="YYYYMMDD" & Time="hhmmss" ????

Oder liege ich da falsch?
 

Zvoni

Erfahrenes Mitglied
So in etwa, wobei ich den kompletten Dateinamen inkl. Pfad zuerst in eine Public-Variable der UserForm speichern würde. Dann kannst du diese Variable vom aufrufenden Code aus auslesen, und gegebenenfalls vorher prüfen.
Ist einfacher zu debuggen.
Aircode
Visual Basic:
Dim DateiNameKomplett As string
'Irgendwo in deinem Code
UserFormDateiName.Show

'Dieser Teil passiert in der UserForm
Public DateiName As String

Private Sub cmdClose_Click()
DateiName=strPfad & "\" & strUser & "_" & "GBCVTAACE_" & txtCVTXX.Text & "_" & Format(Now, "YYYYMMDDhhmmss")
Me.Hide
End Sub

'Wieder zurück im aufrufenden Code
'Irgendwo in deinem Code
UserFormDateiName.Show 'Der Code kehrt erst zurück, wenn die UserForm geschlossen wird, da in VBA alle UserForms modal sind
'Ab hier
DateiNameKomplett=UserFormDateiName.DateiName
UserFormDateiName.Close
Debug.Print DateiNameKomplett  'Zum testen

WorkBook.SaveAs DateiNameKomplett
 

Pr3d4tor

Mitglied
Vielen Dank.

Werde ich mir die Tage mal reinziehen wenn ich die Ruhe dazu habe.
Der erste spontane Versuch bzw. beim CopyPaste in meine Mappe führte dazu das bei
Visual Basic:
Dim DateiNameKomplett As string
'Irgendwo in deinem Code
UserFormDateiName.Show

Die Meldung kam das für UserFormDateiName.Show keine Variable Definiert wurde.

Habe aber gerade nicht wirklich den Kopf dafür.
 

Pr3d4tor

Mitglied
Nabend,

mal ne Frage am Rande, bevor ich hier noch Wochen mit der Suche nach dem Fehler verbringe ;-)
Ist der Aufruf deiner UserForm innerhalb einer Private Sub überhaupt möglich?

Oder übersehe hier noch irgendwas?
Visual Basic:
Private Sub AddCSV()
    
    Dim DateiNameKomplett As String
    UserFormDateiName.Show
    
    Dim strPfad As String
    strPfad = DefaultPath = Environ("Userprofile") & "\Documents\"

    Dim strUser As String
    strUser = Environ("USERNAME")
    
    Dim newWkb As Workbook
    
        Application.ScreenUpdating = False
        Application.EnableEvents = False
    
    Workbooks.Add
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csv_ _
    , Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .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, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
        
        Rows("4:4").Select
        Rows("4:61").Select
        Selection.Delete Shift:=xlUp
        Columns("C:C").Select
        Selection.NumberFormat = "0"
        Columns("D:D").Select
        Selection.NumberFormat = "0"
        
        ActiveSheet.QueryTables(1).Delete
        
        UserFormDateiName.Show 'Der Code kehrt erst zurück, wenn die UserForm geschlossen wird, da in VBA alle UserForms modal sind
        'Ab hier
             DateiNameKomplett = UserFormDateiName.DateiName
             UserFormDateiName.Close
        Debug.Print DateiNameKomplett  'Zum testen

        Workbook.SaveAs DateiNameKomplett, FileFormat:=xlCSV, CreateBackup:=False
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        ActiveSheet.close savechanges:=False
End Sub
In diesem Beispiel erhalte ich direkt am Anfang bei "UserFormDateiName.Show" Variable nich definiert.

Ziehe ich das raus und setzte es vorher ein:
Visual Basic:
Sub UserForm1()

    Dim DateiNameKomplett As String
    UserFormDateiName.Show
    End Sub
    
Private Sub AddCSV()

    Dim DateiNameKomplett As String
    UserFormDateiName.Show
Erhalte ich im unterhalt von ActiveSheet.QueryTables(1).Delete beim nächsten "UserFormDateiName.Show" Variable nich definiert.


Also was Übersehe ich?
 

Zvoni

Erfahrenes Mitglied
Du musst der Form auch den NAMEN "UserFormDateiName" vergeben
Ich hab das nur als Beispiel gebracht....
 

Pr3d4tor

Mitglied
Ja das habe ich dann später auch noch geschnallt ;-)
Werde mich aber wohl noch einiges damit Beschäftigen müssen das so klappt wie gewollt.
Eventuell mach ich dazu einen eigenen Thread auf, mal sehen....
 

Pr3d4tor

Mitglied
Nabend,

hier mal ein kleines Update:
Module1
Visual Basic:
Option Explicit

Public makeName As String
Public fullName As String
Userform: makeName
Visual Basic:
Option Explicit

Private Sub close_Click()

    Dim strPfad As String
    exPfad = "C:\Users\Public\cda\cup\vF\BDV"

    Dim strUser As String
    strUser = Environ("USERNAME")
    
fullName = exPfad & "\" & strUser & "_" & "GBCVTAACE_" & txtCVTXX.Text & "_" & Format(Now, "YYYYMMDDhhmmss")

Me.Hide

End Sub
Der Teil aus dem Modul fullConvert mit UserForm
Code:
Private Sub AddCSV()

    Dim newWkb As Workbook

        Load makeName

        Application.ScreenUpdating = False
        Application.EnableEvents = False
    
    Workbooks.Add

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csv_ _
    , Destination:=Range("A1"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .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, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

        Rows("4:4").Select
        Rows("4:61").Select
        Selection.Delete Shift:=xlUp
        Columns("C:C").Select
        Selection.NumberFormat = "0"

        ActiveSheet.QueryTables(1).Delete

        makeName.Show
        ThisWorkbook.SaveAs fullName, FileFormat:=xlCSV, CreateBackup:=False
        Unload makeName

        Application.EnableEvents = True
        Application.ScreenUpdating = True
        ActiveWorkboook.Close savechanges:=False

End Sub
Das is mein letzter Stand.
Das Öffnen und Importieren in eine neue Arbeitsmappe funzt.
Wenn Sich jetzt noch jemand finden lässte der mir mit der Userform weiterhelfen kann würde ich mich sehr darüber freuen. Dann könnte ich den für mich schwersten Teil des Projektes doch noch abschließen.


VG
 

Neue Beiträge