teste om en fil er åbent
Jeg har en kodestump der eksporterer data fra den åbne fil til en fil med stamoplysninger. Koden starter som nedenfor vist.Nu sker det at der er 2 forskellige brugere der opdaterer til denne fil på samme tid, hvilket er noget skrammel.
Kan man ikke lave en lille "test" på om filen "c:\dokument\opsamling.xlsm" allerede er åbent.
Hvis den er det skal den vente 2 sekunder og prøve igen. Hvis det igen ikke lykkedes skal den loope dette eks. 3 gange.
Er det stadig ikke lykkedes efter 3 gange, skal den komme med beskeden "Filen er optaget i længere tid." og så stoppe eksporten
Beklager den fettede pointgivning men kassen er tom :-)
Sub arkiver_indtastning_ekstern()
Dim RK As Long, Data As Variant
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = Workbooks.Open("c:\dokument\opsamling.xlsm", True, False)
With ThisWorkbook.Sheets("indtastning")
RK = .Range("B65536").End(xlUp).Row ' finder nedeste linje
Data = .Range(.Range("A3"), .Range("D" & RK)) ' området data er fra linje 3 og nedefter
Data2 = .Range(.Range("K3"), .Range("K" & RK))
Data3 = .Range(.Range("F3"), .Range("F" & RK))
Data4 = .Range(.Range("L3"), .Range("L" & RK))
Data5 = .Range(.Range("E3"), .Range("E" & RK))
End With
With wb.Sheets("poster")
RK = .Range("B65536").End(xlUp).Row + 1 ' finder nederste linje og stiller sig i linjen nedenfor
.Range(.Range("B" & RK), .Range("E" & RK + UBound(Data, 1) - 1)) = Data ' indsætter data fra andet ark
.Range(.Range("F" & RK), .Range("F" & RK + UBound(Data, 1) - 1)) = Data2
.Range(.Range("J" & RK), .Range("J" & RK + UBound(Data, 1) - 1)) = Data3 ' indsætter data fra andet ark
.Range(.Range("K" & RK), .Range("K" & RK + UBound(Data, 1) - 1)) = Data4 ' indsætter data fra andet ark
.Range(.Range("I" & RK), .Range("I" & RK + UBound(Data, 1) - 1)) = Data5 ' indsætter data fra andet ark
End With
Application.DisplayAlerts = False
wb.Save
wb.Close
Application.DisplayAlerts = True
End Sub
