AW: aus Datei speichern unter Problem
04.02.2021 11:20:44
Peter
Noch einen Nachtrag:
Es wird die Datei ...Basis.xlsm geöffnet und nach Eintrag von Daten unter einem anderen Namen ...Laufend.xlsm gespeichert mit nachstehendem Code.
Sub SpeichernUnter_Laufend()
Dim Datname As String
Dim Pfad As String
Dim TPfad As String
Pfad = Sheets("Hilfstabelle").Range("X2")
TPfad = Sheets("Hilfstabelle").Range("X13") & "\"
Datname = Sheets("Hilfstabelle").Range("X24") & ".xlsm"
' Debug.Print Pfad
' Debug.Print TPfad
' Debug.Print Datname
' Debug.Print Pfad & TPfad & Datname
ActiveWorkbook.SaveAs Pfad & TPfad & Datname
End Sub
Wenn ich dann die Datei: ...Basis.xlsm öffne mit nachstehendem Code:
Sub Prüfen_PostwertzeichenBasis_geöffnet_und_öffnen()
Dim wb As Workbook
Dim wksH As Worksheet
Dim PfadBasis As String
Dim NameBasis As String
Dim wbBasis As Workbook
Dim fn As String 'benötigt für Prüfung IsWorkbookOpen
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wksH = wb.Worksheets("Hilfstabelle")
PfadBasis = wksH.Range("X20")
'Debug.Print PfadBasis
NameBasis = wksH.Range("X26")
'Debug.Print NameBasis
fn = IsWorkbookOpen(NameBasis)
If fn = "" Then
MsgBox "Die Datei ist nicht geöffnet!"
Application.EnableEvents = False
On Error Resume Next
Set wbBasis = Workbooks.Open(PfadBasis & NameBasis)
If Err.Number > 0 Then MsgBox Err.Description
On Error GoTo 0
Application.EnableEvents = True
Exit Sub
Else
MsgBox "Die Datei " & fn & " ist geöffnet."
End If
Set wbBasis = Nothing
Set wksH = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End Sub
Function IsWorkbookOpen(fn As String) As String
Dim wb As Workbook
For Each wb In Application.Workbooks
If UCase(wb.Name) Like UCase(fn) Then
IsWorkbookOpen = wb.Name
Exit Function
End If
Next wb
IsWorkbookOpen = ""
End Function
Dann wird die ...Basis.xlsm schreibgeschütz geöffnet.
Könnt ihr mir bitte sagen, was ich hier falsch mache?
Gruss
Peter