Zwei Prozeduren, nur eine wird ausgeführt

Hallo zusammen,
ich habe in einer Datei beim Start dieser Datei folgenden Code laufen

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.Run "Daten_aus_manueller_Steuerung_aktualisieren"
Application.Run "alles_aktualisieren"
Workbooks.Open Filename:="Q:\rz\bank21-Reporting\UpdateKundenstamm.xlsm"
Workbooks.Open Filename:="Q:\rz\bank21-Reporting\UpdateKontostammdaten.xlsm"
Application.ScreenUpdating = True
End Sub

Die beiden Prozeduren ...Kundenstamm.xlsm und ... Kontostammdaten.xlsm sollen dafür sorgen, dass auf einem Laufwerk alte Stammdatendateien von den neuen überschrieben werden. Das läuft auch für die jeweils obere Anweisung, egal wie ich das drehe. Es wird nur eine dieser Anweisungen durchgeführt, die andere wird übergangen.
Die Prozeduren sehen übrigens so aus (Aufbau ist gleich, Dateiname unterschiedlich). Sie starten beim öffnen der Dateien Kundenstamm bzw. Kontostammdaten. Die Anweisungen sollen in separaten Dateien stehen, da ich auch von anderen Excel-Dateien darauf zugreifen muss.

'Code in der Persönlichen Makroarbeitsmappe in einem allgemeinen Modul
Sub UpdateKundenstamm()
'Neueste Kundenstammdaten-Datei setzen
Dim strDatei As String
Dim strNeu As String
Dim strDatum As String
Dim strVerzeichnis As String
Dim strName As String
'Verzeichnis mit den Kundenstammdaten -  anpassen !!!
strVerzeichnis = "Q:\rz\bank21-Reporting"
'Dateiname bis zum Beginn des Datums    -  ggf. anpassen !!!
strName = "Kundenstammdaten.xlsx-de."
'neue Stammdatendatei(en) suchen
strDatei = Dir(strVerzeichnis & "\" & strName & "*.xlsx")
If strDatei = "" Then
'Dateiname bis zum Beginn des Datums    -  ggf. anpassen !!!
strName = "Kundenstammdaten.xlsx-de-de."
'neue Stammdatendatei(en) suchen
strDatei = Dir(strVerzeichnis & "\" & strName & "*.xlsx")
End If
If strDatei  "" Then
'neueste Stammdatendatei ermitteln
strNeu = strDatei
'    strDatum = FileDateTime(strDatei)
strDatum = Mid(strDatei, Len(strName) + 1, 8)
Do
strDatei = Dir
If strDatei = "" Then Exit Do
'If strDatum  "" Then
VBA.Kill strVerzeichnis & "\Kundenstammdaten.xlsx"
End If
'neue Datei als Stammdatendatei kopieren
VBA.FileCopy strVerzeichnis & "\" & strNeu, strVerzeichnis & "\Kundenstammdaten.xlsx"
'neue Datei mit Datum-Zeit-Stempel löschen
If strVerzeichnis & "\" & strNeu  "" Then
VBA.Kill strVerzeichnis & "\" & strNeu
End If
End If
'Arbeitsmappe schließen
ActiveWorkbook.Close SaveChanges:=False
End Sub

Was kann ich tun?
Gruß
Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Frank,
von Genosse zu Genosse (so schließe ich das aus den Verzeichnisnamen ;-) ) will ich eine Antwort versuchen. So wie ich das verstehe, möchtest Du Code so ablegen, dass man ihn zentral pflegen und von mehreren Dateien aus nutzen kann. Dein Ansatz, je Arbeitspaket eine eigene Datei anzulegen und den benötigten Code automatisch beim Öffnen der Datei ausführen zu lassen, ist recht kreativ. Ohne die Dateien zu sehen und zu testen kann ich nur spekulieren, warum er scheitert. Ich vermute einfach Timing-Probleme. Wenn der Code der beiden Dateien parallel ausgeführt wird, wird z. B. das "ActiveWorkbook.close" der ersten Datei die zweite Datei schließen, weil diese ja inzwischen das ActiveWorkbook ist. Dies könntest Du umgehen, wenn Du stattdessen "Thisworkbook" verwendest.
Für zentral gepflegten Code würde ich Dir jedoch dringend die Nutzung eines Add-Ins empfehlen. Aus diesem könntest Du die benötigten Prozeduren aufrufen und wärst sicher, dass die Ausführung nacheinander erfolgt.
Ich hoffe, das hilft Dir weiter!
Gruß, Jürgen

Sub DateiUpdate(Stammdatentyp As String) Dim strAktDateiname As String Dim strAktDatum As String Dim strNeuestesDatum As String Dim strNeuesteDatei As String Dim Antwort As VbMsgBoxResult Const strDateiEnde As String = "-064.xlsx" Const strVerzeichnis As String = "Q:\rz\bank21-Reporting\" strNeuestesDatum = "" strNeuesteDatei = "" strAktDateiname = Dir(strVerzeichnis & Stammdatentyp & "*" & strDateiEnde) Do Until strAktDateiname = "" strAktDatum = Left(Right(strAktDateiname, 8 + Len(strDateiEnde)), 8) If strAktDatum > strNeuestesDatum Then strNeuestesDatum = strAktDatum strNeuesteDatei = strAktDateiname End If strAktDateiname = Dir() Loop If strNeuesteDatei "" Then Antwort = MsgBox("Folgende Datei scheint die neueste zu sein: " & _ vbCr & strNeuesteDatei & vbCr & vbCr & "Fortfahren?", _ vbQuestion + vbYesNo + vbDefaultButton2, "Sicherheitsabfrage") If Antwort = vbYes Then FileCopy (strVerzeichnis & strNeuesteDatei), (strVerzeichnis & Stammdatentyp & ".xlsx") _ End If Else MsgBox "Keine " & Stammdatentyp & "-Datei gefunden!", vbInformation End If End Sub

Beliebteste Forumthreads (12 Monate)

Zwei Prozeduren, nur eine wird ausgeführt

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread