AW: Glaskugel???
06.11.2003 18:41:48
Semmi
Hallo Martin,
sorry, wie ich schon sagte, ich habe absolut keine Ahnung!!!! Und der Kollege, der das programmiert hat, ist nicht greifbar und wir haben hier keinen der sich auskennt...
Hier also der komplette Code:
Sub TabellenAddition()
Dim lngCALC As Long
Dim intSHEETS As Integer
Dim intSHEET As Integer
Dim objCELL As Range
Dim strFILE As String
Dim objFILE As Workbook
Dim varRANGE() As String
Dim objVALUE As Range
Dim varVALUE As Variant
Dim lngERROR As Long
Dim strMESSAGE As String
Dim strPATH As String
lngCALC = Application.Calculation
Application.Calculation = xlManual
With ThisWorkbook
'-> altes Fehlerprotokoll löschen
With tabERROR
.Rows("6:16384").ClearContents
.Cells(2, 5).Value = Date
.Cells(3, 5).Value = Time
End With
'-> alte Addition löschen
For Each objCELL In tabKEYS.Columns(3).Cells
If objCELL.Value <> vbNullString Then
intSHEET = intSHEET + 1
ReDim Preserve varRANGE(intSHEET)
varRANGE(intSHEET) = tabKEYS.Cells(intSHEET, 4).Value
.Sheets(intSHEET).Range(varRANGE(intSHEET)).ClearContents
Else
Exit For
End If
Next
'-> Verzeichnis für Eingabedateien ermitteln
strPATH = tabKEYS.Cells(1, 6).Value
'-> Eingabedateien verarbeiten
For Each objCELL In tabKEYS.Columns(1).Cells
If objCELL.Value = vbNullString Then Exit Sub
' If Datei.Value = "" Then GoTo ENDE
strFILE = strPATH & "\" & objCELL.Value
strFILE = Dir(strFILE)
If strFILE = vbNullString Then
Err = 53
lngERROR = lngERROR + 1
strMESSAGE = Error()
tabERROR.Rows(5 + lngERROR).Columns("A:E").Value = _
Array(lngERROR, CStr(objCELL.Value), Err, "", strMESSAGE)
Err = 0
Else
Set objFILE = Workbooks.Open(strPATH & "\" & strFILE)
' Setze Startzeit
lngERROR = lngERROR + 1
tabERROR.Rows(5 + lngERROR).Columns("A:E").Value = _
Array(lngERROR, objFILE.Name, "", "", Time)
For intSHEET = 1 To UBound(varRANGE)
With .Sheets(intSHEET)
On Error Resume Next
For Each objVALUE In .Range(varRANGE(intSHEET)).Cells
varVALUE = objFILE.Sheets(intSHEET).Cells(objVALUE.Row, objVALUE.Column).Value
varVALUE = CDbl(varVALUE)
If Err = 0 Then
objVALUE.Value = objVALUE.Value + varVALUE
objVALUE.NumberFormat = "0"
Else
lngERROR = lngERROR + 1
strMESSAGE = "Unerwarteter Fehler : " & Error()
tabERROR.Rows(5 + lngERROR).Columns("A:E").Value = _
Array(lngERROR, " ", Err, .Name & "!" & objVALUE.Address, strMESSAGE)
Err = 0
End If
Next
On Error GoTo 0
End With
Next intSHEET
objFILE.Close Savechanges:=False
End If 'Datei vorhanden
Next
' Setze Endezeit
lngERROR = lngERROR + 1
With tabERROR.Rows(5 + lngERROR)
.Columns("A:E").Value = Array(lngERROR, " ", " ", Date, Time)
End With
End With
Application.Calculation = lngCALC
End Sub
In der Hoffnung, dass das jetzt wiederum nicht zu verwirrend ist.....
Vielen Dank trotzdem erst einmal für die Mühe.
Semmi