Microsoft Excel

Herbers Excel/VBA-Archiv

Temporäre Datei


Betrifft: Temporäre Datei von: Tom
Geschrieben am: 22.01.2019 16:02:01

Hallo zusammen,‎

ich bin immer noch nicht mit dem Problem weitergekommen. ‎
Mein Makro liest unter einem festzugteilten Laufwerk alle darin abgelegten Excel-Dateien aus und legt ‎die Inhalte ab. Wenn jedoch einer der Dateien geöffnet ist, bricht die Prozedur (bei .Open strSQL) ab ‎und ich muss warten bis die Datei wieder geschlossen wird, damit ich keinen Abbruch ‎erhalte. Ich möchte die geöffneten Dateien beim Auslesen überspringen lassen oder die temporäre Kopie auslesen ‎lassen. Unten folgend der Code. Kann sich das jemand anschauen und unterstützen? ‎

Gruß Tom

Sub Fahrzeugdatei_auslesen()‎
Dim sPath$, sDir$, ArFile()‎
Dim n&, nRow&
Dim ArInhalt
Dim iCalc%‎

‎'hier den Pfad angeben‎
sPath = "L:\"‎

sPath = IIf(Right$(sPath, 1) <> "\", sPath & "\", sPath)‎

sDir = Dir(sPath & "*.xlsm", vbNormal)‎
Do While sDir <> ""‎
‎ ReDim Preserve ArFile(n)‎
‎ ArFile(n) = sDir
‎ n = n + 1‎
‎ sDir = Dir()‎
Loop

If n > 0 Then
‎ With Application
‎ iCalc = .Calculation
‎ .ScreenUpdating = False‎
‎ .EnableEvents = False‎
‎ .Calculation = xlCalculationManual‎

‎ For n = LBound(ArFile) To UBound(ArFile)‎
‎ ArInhalt = oExAbfrage(sPath & ArFile(n), "Fahrzeugdatei$K2:AB3", True)‎
‎ If IsArray(ArInhalt) Then
‎ With Tabelle3‎
‎ If nRow = 0 Then
‎ .Range("B2:C" & .Rows.Count).ClearContents‎
‎ nRow = 2‎
‎ End If
‎ With .Cells(nRow, 2).Resize(UBound(ArInhalt))‎
‎ .Value = ArInhalt‎
‎ .Offset(, 1).Value = ArFile(n)‎
‎ End With
‎' nRow = nRow + 12‎
‎ nRow = nRow + 14‎
‎ End With
‎ End If
‎ Next n
‎ ‎
‎ .ScreenUpdating = True‎
‎ .EnableEvents = True‎
‎ .Calculation = iCalc‎
‎ End With
End If

End Sub Option Explicit

‎'ab xl2007‎
Private Const cProvider As String = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ="‎

Private cnMDB As Object ' oder ADODB.Connection -> 'Verweis auf: Microsoft ActiveX Data Objects ...‎
Private adoRS As Object ' oder ADODB.Recordset -> 'Verweis auf: Microsoft ActiveX Data Objects ...‎

Private Sub Close_Datenbank()‎
On Error Resume Next
‎    adoRS.Close
‎    Set adoRS = Nothing
‎    cnMDB.Close
‎    Set cnMDB = Nothing
End Sub
Private Sub ADO_Connect(strFile$)‎
Dim sPath$, sAdoConnectString$‎

Set cnMDB = CreateObject("ADODB.Connection") '‎

‎'1. Version so‎
sAdoConnectString = cProvider & strFile
cnMDB.Open sAdoConnectString

End Sub
Private Sub Oben_Recordset(ByVal strSQL$)‎
Set adoRS = CreateObject("ADODB.Recordset")‎

With adoRS
‎  .ActiveConnection = cnMDB‎
‎  .CursorLocation = 3‎
‎  .CursorType = 2‎
‎  .LockType = 3‎
‎  .Open strSQL‎
End With
End Sub

Function oExAbfrage(ByVal strFile$, ByVal sTabAndRange$, Optional booCloseDB As Boolean = False)‎
Dim strSQL$, arValues(), n&, nCounter&

If cnMDB Is Nothing Then ADO_Connect strFile
If cnMDB Is Nothing Then GoTo ErrorConnect 'Error

strSQL = "SELECT * FROM [" & sTabAndRange$ & "]"‎

If adoRS Is Nothing Then
‎ Oben_Recordset strSQL
‎ If adoRS Is Nothing Then GoTo ErrorConnect 'Error
End If

With adoRS
‎ If Not .BOF Then
‎ ReDim Preserve arValues(1 To 1, 1 To .Fields.Count)‎
‎ For n = 0 To .Fields.Count - 1‎
‎ If .Fields(n) <> "" Then nCounter = nCounter + 1: arValues(1, nCounter) = .Fields(n).Value
‎ Next n
‎ ReDim Preserve arValues(1 To 1, 1 To nCounter)‎
‎ oExAbfrage = Application.Transpose(arValues)‎
‎ End If
End With

If booCloseDB Then Close_Datenbank
Exit Function

ErrorConnect:‎
‎ Close_Datenbank
‎ oExAbfrage = "Error"‎
End Function

  

Betrifft: AW: Temporäre Datei von: Rudi Maintaire
Geschrieben am: 22.01.2019 23:31:53

Hallo,
frag ab ob die Datei geöffnet ist.
Google: IsFileOpen

Gruß
Rudi


Beiträge aus dem Excel-Forum zum Thema "Temporäre Datei"