Code vorzeitig verlassen

Forumthread: Code vorzeitig verlassen

27.06.2016 14:41:44

Markus

Liebes Forum,
wie müsste ich den Code ergänzen, damit dieser abgebrochen wird, sobald die Datei "Quelle" nicht geöffnet/vorhanden ist? Will den Laufzeitfehler vermeiden.
Habe es mit
- If "Quelle_" & Format(Date, "dd.mm") = "" Then Exit Sub
probiert, jedoch erfolglos.
Hier der Code:
Option Explicit

Sub kopieren()
Dim zSh As Worksheet ' z wie Ziel
Dim StDatei As String
StDatei = "Quelle_" & Format(Date, "dd.mm")
Set zSh = Workbooks("Ziel.xlsm").Worksheets("Tabelle1")
zSh.Unprotect
Workbooks(StDatei & ".xlsm").Worksheets("Tabelle1").Range("A1:F30").Copy
With zSh.Range("A1")
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
zSh.Range("A1:A30").Locked = False
zSh.Range("B1:E30").Locked = True
zSh.Range("F1:F30").Locked = False
zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
zSh.EnableSelection = xlUnlockedCells
End Sub

Vielen Dank euch!

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code vorzeitig verlassen

27.06.2016 14:57:15

Michael
AW: Code vorzeitig verlassen

27.06.2016 17:56:09

Markus
wer anders bitte, muß aus dem Haus

27.06.2016 18:03:40

Michael
so, jetzt

28.06.2016 09:21:10

Michael
AW: so, jetzt

29.06.2016 13:48:31

Markus
ok, super, gern geschehen,

29.06.2016 14:19:33

Michael

AW: Code vorzeitig verlassen

27.06.2016 17:56:09

Markus

Hallo Michael,
funktioniert nur fast perfekt. Meldung erscheint, dass er die Datei nicht finden konnte - jedoch erscheint auch der Laufzeitfehler.
Sub kopieren()
Dim zSh As Worksheet ' z wie Ziel
Dim StDatei As String
Call DateiOeffnen
StDatei = "Quelle_" & Format(Date, "dd.mm")
Set zSh = Workbooks("Ziel.xlsm").Worksheets("Tabelle1")
zSh.Unprotect
Workbooks(StDatei & ".xlsm").Worksheets("Tabelle1").Range("A1:F30").Copy
With zSh.Range("A1")
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
zSh.Range("A1:A30").Locked = False
zSh.Range("B1:E30").Locked = True
zSh.Range("F1:F30").Locked = False
zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
zSh.EnableSelection = xlUnlockedCells
End Sub Habe den Code wahrscheinlich falsch angepasst.
Sub DateiOeffnen()
Dim sFile As String, sPath As String
sFile = "StDatei"
sPath = ThisWorkbook.Path & "\" & sFile
If WkbExists(StDatei & ".xlsm") = False Then
If Dir(sPath) = "" Then
MsgBox "Datei " & sPath & " wurde nicht gefunden!"
Else
Workbooks.Open sPath
End If
Else
Workbooks(sFile).Activate
End If
End Sub

Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function

Vielen Dank.

wer anders bitte, muß aus dem Haus

27.06.2016 18:03:40

Michael

Gruß,
M.

so, jetzt

28.06.2016 09:21:10

Michael

Hi Markus,
es rächt sich immer wieder, wenn man nicht mit "Option explicit" arbeitet. Das gehört einfach in die erste Zeile eines jeden Moduls bzw. im VBA-Editor unter Extras/Optionen angehakt:
Userbild

Der Punkt ist nämlich, daß die Variable StDatei zwar in der Sub kopieren deklariert ist, nicht jedoch in DateiOeffnen: also wird sie dort als Leerstring neu angelegt.
Also, hier in Modul1:

Option Explicit
Sub kopieren()
Dim zSh As Worksheet ' z wie Ziel
Dim StDatei As String, StPfad As String
Dim ImportWB As Workbook
Set zSh = Worksheets("Tabelle1")
StDatei = "Quelle_" & Format(Date, "DD.MM") & ".xlsx"
' *** auf xlsx geändert; falls xlsm halt wieder ersetzen
StPfad = ThisWorkbook.Path & "\" & StDatei
If WkbExists(StDatei) = False Then
If Dir(StPfad) = "" Then
MsgBox "Datei " & StPfad & " wurde nicht gefunden!"
Exit Sub
Else
Workbooks.Open StPfad ' evtl. readonly=true?!
' hier der komplette Pfad für Laufwerks-Zugriff
End If
Else
Workbooks(StDatei).Activate
' hier nur der Name der bereits geöffneten Datei
End If
zSh.Unprotect
' zu diesem Zeitpunkt ist StDatei das "ActiveWorkbook"
ActiveWorkbook.Worksheets("Tabelle1").Range("A1:F30").Copy zSh.Range("A1")
' wenn sonst nichts zu kopieren ist, gleich wieder schließen
ActiveWorkbook.Close False ' ohne Speichern
' jetzt ist die ohnehin geöffnete Datei wieder das ActiveWorkbook
Application.CutCopyMode = False
zSh.Range("A1:A30").Locked = False
zSh.Range("B1:E30").Locked = True
zSh.Range("F1:F30").Locked = False
zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
zSh.EnableSelection = xlUnlockedCells
End Sub
Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function

Schöne Grüße,
Michael

AW: so, jetzt

29.06.2016 13:48:31

Markus

Hallo Michael,
funktioniert perfekt - vielen Dank nochmal.

ok, super, gern geschehen,

29.06.2016 14:19:33

Michael

Markus,
Gruß zurück,
Michael

Beliebteste Forumthreads (12 Monate)

Forumthread: Code vorzeitig verlassen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread