Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem bei Dateicheck

Forumthread: Problem bei Dateicheck

Problem bei Dateicheck
07.01.2006 11:34:47
Peter
Hallo,
ich habe Probleme bei der Überprüfung der Datei (offen/zu) wenn
ich die zu überprüfende Datei mit Variablen benenne.
Wer kann helfen?
Danke für die Mühe im voraus
Peter
'Option Explicit
'In DieseArbeitsmappe:
'

Private Sub Workbook_Open()
'Call DateiCheck
'End Sub

'--Quelldatei--
'F:\Abtlng1\Material
'Dateiname:Abtlng1.xls
'Blattname:Verbrauch
Sub DateiCheck()
Dim offen As Boolean
Dim sfile, QName As String
Application.ScreenUpdating = False
QName = "Abtlng1"
sfile = QName & ".xls"
offen = DateiOffen(QName & ".xls")
If offen = True Then
Call Kopieren
Else
'ChDir "F:\" & QName & "\Material"
'Fehler>>> 'Workbooks.Open (sfile)
Workbooks.Open Filename:="F:\Abtlng1\Material\Abtlng1.xls"
Call Kopieren
Workbooks(sfile).Close False
End If
End Sub
Function DateiOffen(sfile As String) As Boolean
'Check ob Datei geöffnet ist
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sfile)
If Not wkb Is Nothing Then
DateiOffen = True
Else
DateiOffen = False
End If
End Function
Sub Kopieren()
Dim LRow As Long
Dim QSh, ZSh As Object
Set QSh = Workbooks("Abtlng1.xls").Worksheets("Verbrauch")
Set ZSh = ThisWorkbook.Worksheets("GesVerbrauch")
LRow = QSh.Cells(Rows.Count, 2).End(xlUp).Row
ZSh.Cells.ClearContents
ZSh.Range(ZSh.Cells(2, 1), ZSh.Cells(LRow, 15)).Value = _
QSh.Range(QSh.Cells(2, 1), QSh.Cells(LRow, 15)).Value
ZSh.Columns.AutoFit
End Sub
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem bei Dateicheck
07.01.2006 12:29:36
Peter
Servus,
so gehts, das On Error könntest du mit einer Schleife vermeiden, geht aber auch so.
Public Function Dat_offen(strDatnam As String) As Boolean
Dim wbk As Workbook
If Right(strDatnam, 4) <> ".xls" Then strDatnam = strDatnam & ".xls"
On Error Resume Next
Set wbk = Workbooks(strDatnam)
If wbk Is Nothing Then
Dat_offen = False
Else
Dat_offen = True
End If
End Function

MfG Peter
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige