AW: Datei nicht öffnen wenn in Bearbeitung
22.05.2014 17:39:05
Jens
Hallo Daniel,
das Makro läuft, nochmals herzlichen Dank. Es ist sicherlich für die Profis etwas umständlich geschrieben aber ich bin "stolz wie Oskar" das es jetzt so tut. Hättest du vielleicht Zeit kurz nocheinmal auf das Gesamte Werk zu schauen, ob man da etwas optimieren könnte. Ich habe z.b. eine Datei in die ich aus 61 Dateien ein Blatt kopiere. Im Moment öffne ich in der Schleife immer beide Dateien und schließe Sie dann auch wieder. Die Eine könnte aber auch offen bleiben, das würde den Prozess schon kürzer machen.
Nochmal kurz was passieren soll. Aus einer Datei heraus in der das Marko läuft sollen 61 DAteien nacheinander geöffnet und aktualisiert werden, diese sind in der Datei wo das Makro läuft in einer Spalte untereinander. aus den Dateien soll das Datenblatt Summary komplett kopiert werden und in die Summary Datei kopiert werden. In der Summary Datei gibt es pro Datei ein Tabellenblatt wenn nicht schon vorhanden wird es erzeugt und erhält einen bestimmten Namen. Bei weiteren Durchläufen soll einfach nur aktualisiert werden.
Danach die Dateien schließen.
Vielen Dank.
Hier mal der Code:
Sub Auslesen_land()
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Call auslesen
Application.DisplayAlerts = True
End Sub
Public Function auslesen()
Dim Pfad As String
Dim Pfad_m As String
Dim Datei As String
Dim Datei_m As String
Dim Datei_3 As String
Dim Datei_4 As String
Dim Name_1 As String
Dim Name_2 As String
Dim Name_3 As String
Dim Name_4 As String
Dim g As String
Dim a As Long
Dim i As Long
Dim bytAnzahl As Byte
Dim wSheet As Worksheet
a = Sheets("Auswahl").Cells(1, 6)
Pfad_r = Range("c17").Value
For i = 1 To a
With ThisWorkbook.Worksheets("Auswahl")
Pfad = .Range("H1").Value
Name_3 = .Range("k" & i + 2).Value
Name_4 = .Range("J" & i + 2).Value
Datei = .Range("h" & i + 2).Value
Name_2 = .Range("q" & i + 2).Value
g = Format(Name_3, "dd.mm.yyyy") & "-" & Format(Name_4, "hh:nn:ss")
End With
Pfad_Datei = Pfad & Datei
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=Pfad_Datei
If Not Workbooks(Datei).ReadOnly Then
If WorkSheetExists("1_summary") Then
Calculate
Sheets("1_summary").Select
Cells.Select
Selection.Copy
Workbooks.Open Filename:=Pfad_r 'diese Datei könnte auch immer offen bleiben, mann mü _
sste Sie nur an dieser Stelle ansteuern
If WorkSheetExists(Name_2) Then
Worksheets(Name_2).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Name_2
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Range("A1").Select
ActiveCell.FormulaR1C1 = g
ActiveWorkbook.save
ActiveWorkbook.Close
ActiveWorkbook.save
ActiveWorkbook.Close
Else
End If
Else
End If
Next i
End Function
Public Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not Worksheets(strName) Is Nothing
End Function