Code von Tabellenblatt in Modul

[Gardinenhaken]

Hallo Atilla,

Ich wollte gerade einen Beitrag schicken, wie man eine geöffnete Datei erfragen kann.
Das hast Du ja nun schneller gemacht :18:

Oben habe ich auch geschrieben, daß ich mitlernen werde.
Dein Beitrag lautete: Prüfung, ob eine Datei im Netz bereits geöffnet ist.
Ich finde aber keine Netzabfrage, sondern einen Pfad, der auf das Laufwerk C:\... weist.

Da Herbert nun schreibt, daß es geklappt hat, entnehme ich der ganzen Geschichte,
daß es im Code Wurscht ist, ob es sich um ein Netzlaufwerk oder um ein lokales Laufwerk handelt.

Ist das soweit richtig, oder ist meine Überlegung falsch?

[atilla]

Hallo Peter,

Dein Beitrag lautete: Prüfung, ob eine Datei im Netz bereits geöffnet ist.

so hat Herber das Thema benannt.

Ist das soweit richtig, oder ist meine Überlegung falsch?

Ich verstehe es nicht anders.

[herbert0803]

Hallo Peter,

Ich finde aber keine Netzabfrage, sondern einen Pfad, der auf das Laufwerk C:\... weist.

Ich habe zu Testzwecken die Dateien lokal bearbeitet. Daher ist teilweise der Verweis auf C:\... vorhanden.
Es funktioniert aber auch mit Netzlaufwerken, bei mir Y:\...

Ich stelle hier noch den Teil vom Code für die Abfrage ob die Datei geöffnet ist zur Verfügung.

Code:

Option Explicit
'Funktion für Abfrage ob Summendatei geöffnet
Private Function TestOpen(sPath As String) As Integer
   If Dir(sPath) = "" Then
      TestOpen = 2
   Else
      On Error GoTo ERRORHANDLER
      Open sPath For Random Access Read Lock Read Write As #1
      Close #1
   End If
ERRORHANDLER:
   If Err = 70 Then TestOpen = 1
End Function

Sub Datenweitergabe()
    Dim LoLetzte As Long
    Dim inAbfrage As Integer
    Dim DatName As String, DatPfad As String
    Dim curWkb As Workbook, curWks As Worksheet
    Dim Datprüf  'As String
    Dim msga As String 'Definition Msgboxvariable "Datensatz vorhanden ..."
    Dim suchvar As Range
    Dim BstName As String
    
      
    Set curWkb = Workbooks(ActiveWorkbook.Name)
    Set curWks = curWkb.Worksheets(ActiveSheet.Name)
    
    DatName = "BA_Summen.xlsx" 'Dateiname anpassen
    DatPfad = "Y:\Summen" & "\" 'Dateipfad anpassen
    BstName = ActiveSheet.Name  'Variable für Tabellenblatt
    Datprüf = curWks.Range("Datum") 'Variable für Datum

    Application.ScreenUpdating = False
    
    'Abfrage ob Summendatei geöffnet (In Verbindung mit Funktion)
    
    Dim iOpen As Integer
    Dim sFile As String
    sFile = DatPfad & DatName
    If sFile = "" Then Exit Sub
    iOpen = TestOpen(sFile)
    Select Case iOpen
    'Case 0: MsgBox "Die Summendatei " & sFile & " ist frei"
    Case 1: MsgBox "Die Summendatei ist geöffnet!" & vbCrLf & _
            "Bitte die geöffnete Datei schließen und den Übertrag nochmals starten!" & vbCrLf & vbCrLf & _
            sFile, 48, "Achtung"
    Case 2: MsgBox "Die Summendatei wurde nicht gefunden" & vbCrLf & _
            "Bitte Kontrollieren!" & vbCrLf & vbCrLf & _
            sFile, 48, "Achtung"
    End Select
    
    If iOpen = 1 Then Exit Sub
    If iOpen = 2 Then Exit Sub

    'Summendatei öffnen und Datumsabfrage
    curWks.Range("Datum").Copy
    Workbooks.Open DatPfad & DatName

weiterer Code ....

Danke für die Hilfe an Atilla.

[Käpt'n Blaubär]

Hallo Herbert,

Danke für Deine Ausführungen.
Ich werde mich jetzt mal ein bischen mehr um die Netzwerk-Problematik kümmern.

Und für Dich freut es mich natürlich, daß das so problemlos geklappt hat :19: