VBA: Workbook open ohne direkten Dateinamen

Sub SucheDatei () Dim Dateiname As String, Suchbegriff As String, Pfad As String Pfad = "P:\Test Ordner\" Suchbegriff = UserForm1.TextBox1 ' Inhalt der TextBox Bsp. Max _ Muster Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx") If Dateiname "" Then Workbooks.Open Pfad & Dateiname End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub SucheDatei() Dim Dateiname As String, Suchbegriff As String, Pfad As String Dim wkbBook As Workbook Pfad = "P:\Test Ordner\" Suchbegriff = UserForm1.TextBox1 ' Inhalt der TextBox Bsp. Max Muster Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx") If Dateiname "" Then Set wkbBook = Workbooks.Open(Pfad & Dateiname) MsgBox wkbBook.FullName ' Ausgabe Pfad und Name wkbBook.Close False ' Workbook schliessen OHNE speichern End If End Sub

Sub Schreiben() Dim wkbBook As Workbook Set wkbBook = Worksheets("Tab1").Activate With Worksheets("Tab1") Range("C3").Value = UserForm1.TextBox3 Range("D3").Value = UserForm1.TextBox4 Range("E3").Value = UserForm1.TextBox5 Range("F3").Value = UserForm1.TextBox6 End With End Sub

Sub Schreiben() Dim wkbBook As Workbook Set wkbBook = Activeworkbook With wkbBook.Worksheets("Tab1") .Range("C3").Value = UserForm1.TextBox3 .Range("D3").Value = UserForm1.TextBox4 .Range("E3").Value = UserForm1.TextBox5 .Range("F3").Value = UserForm1.TextBox6 End With End Sub

Sub SucheDatei() Dim Dateiname As String, Suchbegriff As String, Pfad As String Dim wkbBook As Workbook Pfad = "P:\Test Ordner\" Suchbegriff = UserForm1.TextBox1 ' Inhalt der TextBox Bsp. Max Muster Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx") If Dateiname "" Then Set wkbBook = Workbooks.Open(Pfad & Dateiname) MsgBox wkbBook.FullName ' Ausgabe Pfad und Name wkbBook.Close False ' Workbook schliessen OHNE speichern End If End Sub

Sub Schreiben () Dim wkbBook As Workbook Set wkbBook = Activeworkbook With wkbBook.Worksheets("Tab1") .Range("C3").Value = UserForm1.TextBox3 .Range("D3").Value = UserForm1.TextBox4 .Range("E3").Value = UserForm1.TextBox5 .Range("F3").Value = UserForm1.TextBox6 End With End Sub

Public wkbBook As Workbook Sub SucheDatei() Dim Dateiname As String, Suchbegriff As String, Pfad As String Pfad = "P:\Test Ordner\" Suchbegriff = UserForm1.TextBox1 ' Inhalt der TextBox Bsp. Max Muster Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx") If Dateiname "" Then Set wkbBook = Workbooks.Open(Pfad & Dateiname) End If End Sub Sub Schreiben () With wkbBook.Worksheets("Tab1") .Range("C3").Value = UserForm1.TextBox3 .Range("D3").Value = UserForm1.TextBox4 .Range("E3").Value = UserForm1.TextBox5 .Range("F3").Value = UserForm1.TextBox6 End With wkbBook.Close False ' Workbook schliessen OHNE speichern set wkbBook = Nothing End Sub

'Diese Zeile mit Variablendeklaration oben im Code-Module vor allen Prozeduren Private wkbBook As Workbook Sub SucheDatei() Dim Dateiname As String, Suchbegriff As String, Pfad As String Pfad = "P:\Test Ordner\" Suchbegriff = UserForm1.TextBox1 ' Inhalt der TextBox Bsp. Max Muster Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx") wkbBook If Dateiname "" Then Set wkbBook = Workbooks.Open(Pfad & Dateiname) Else Set wkbBook = Nothing End If End Sub Sub Schreiben() If wkbBook Is Nothing Then MsgBox "Es wurde noch keine Mappe geöffnet und der Variablen wkbBook zugewiesen", _ vbOKOnly, "Makro Schreiben" Else With wkbBook.Worksheets("Tab1") .Range("C3").Value = UserForm1.TextBox3 .Range("D3").Value = UserForm1.TextBox4 .Range("E3").Value = UserForm1.TextBox5 .Range("F3").Value = UserForm1.TextBox6 End With wkbBook.Close True ' Workbook schliessen MIT speichern Set wkbBook = Nothing End If End Sub

Guten Morgen
Werner u. Franz
Habe mir eure Antworten durch gesehen u. Sie eingesetzt, mit ner kleinen Änderung.
Franz, wenn Ich den Code so lasse bekomme Ich eine Fehlermeldung die Markierung ist bei (wkbBook) gesetzt. Habe dies kleine Zeile Auskommentiert u. siehe da es geht.


Dateiname = Dir(Pfad & "*" & Suchbegriff & "*.xlsx")
'wkbBook

Ebenso habe Ich diese Zeile Auskommentiert, warum siehe Unten...

wkbBook.Close True ' Workbook schließen MIT speichern

Soweit so gut...
Nun stehe Ich vor einem neuen Problem.
Ich habe ja die Zeile "wkbBook.Close True" Auskommentiert weil Ich an dieser Stelle noch etwas vorhabe.
Ich möchte die per Suchbegriff geöffnette Mappe u. bereits beschrieben nun Speichern aber mit einem Neuen Dateinamen in einem anderen Ordner.
Mein Save-Button sieht so aus:

Private Sub Cbu_Save_Click()
Dim Datei As String, Verzeichnis As String, SaveDummy As Variant
Call M_UF5.Schreibe
Select Case Me.CB_Bereich_Aus
Case "WB 1"
Verzeichnis = "P:\Test Ordner\Ausgezogen\"
Datei = Me.TB_Dateiname_Neu.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy  False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
ThisWorkbook.Activate
' hier kommt eine weitere Speicher möglichkein
' beide Möglichkeiten sollen in eine Abfrage wo gespeichert werden soll
'        Case "WB 2"
' Code frei, wird noch befühlt
'        Case "WB 3"
' Code frei, wird noch befühlt
'        Case "Haus"
' Code frei, wird noch befühlt
Case Else
End Select
Call M_UF5.Inhalt_Löschen
End Sub
Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, _
FileFilter:="Excel Dateien (*.xlsx),*.xls*", FilterIndex:=1, _
Title:="Speichern Unter...", ButtonText:="speichern")
End Function

Bei einem anderen Project geht dies mit Dateinamen u. neuem Ordner, darum die Case Zeilen klappte ganz gut.
Nun passiert bei diesem Project nichts, keine Fehlermeldung u. kein Speichern.
Habt Ihr vieleicht einen Ahnung woran es liegen kann?
Gruß Charly

Private Sub Cbu_Save_Click() Dim Datei As String, Verzeichnis As String, SaveDummy As Variant Dim iClick As Integer iClick = MsgBox( _ prompt:="In welchen Ordner soll Gespeichert werden?" & vbCrLf & _ "Einzug, Klicke (Ja) oder Auszug, Klicke (Nein)", _ Buttons:=vbExclamation + vbYesNoCancel) If iClick = vbYes Then Call M_UF5.Schreibe_Protokoll_Stamm Verzeichnis = "P:\Test HM2030\Einzug\" Datei = Me.TB_Dateiname_Neu & ".xlsx" SaveDummy = SpeichernUnter(Verzeichnis & Datei) If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy, xlOpenXMLWorkbook Range("A1").Select ActiveWorkbook.Close Unload Me ThisWorkbook.Activate MsgBox "Die Daten wurde Übernommen u. die Datei wurde im jeweiligen Ordner Angelegt.", _ vbInformation ElseIf iClick = vbNo Then Call M_UF5.Schreibe_Protokoll_Stamm Verzeichnis = "P:\Test HM2030\Auszug\" Datei = Me.TB_Dateiname_Neu & ".xlsx" SaveDummy = SpeichernUnter(Verzeichnis & Datei) If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy, xlOpenXMLWorkbook Range("A1").Select ActiveWorkbook.Close Unload Me ThisWorkbook.Activate MsgBox "Die Daten wurde Übernommen u. die Datei wurde im jeweiligen Ordner Angelegt.", _ vbInformation ElseIf iClick = vbCancel Then Call M_Allg_Schliessen.WorkBookColse Unload UF5_Protokoll MsgBox "Die Instanz wurde geschlossen, Eingabe wurde beendet.", vbInformation End If End Sub Function SpeichernUnter(VorgabeName As String) As Variant SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, _ FileFilter:="Excel Dateien (*.xlsx),*.xls*", FilterIndex:=1, _ Title:="Speichern Unter...", ButtonText:="speichern") End Function

Beliebteste Forumthreads (12 Monate)

VBA: Workbook open ohne direkten Dateinamen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA: Workbook open ohne direkten Dateinamen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread