application.ontime - irgendwo hängts!!!
13.05.2008 10:12:01
Stefan
ich habe nachfolgenden Code geht excel mir immer in der errHandler: und gibt mir die Messagebox aus (obwohl die Datei vorhanden ist!!!).
wenn ich den Code über eine Userform aufrufe, dann funktioniert es.
Habt ihr ne Idee, wo der Fehler sein könnte?
Gruß
Stefan
Public Start As Boolean
Public Startzeit As Date
Sub Aufforderung()
If Start = True Then
If Dir("c:\wetterdaten\test.csv") "" Then
Sheets("importierte Daten").Select
Cells.Select
Selection.ClearContents
'Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TextBox2, _
Destination:=Sheets("importierte Daten").Range("A1"))
On Error GoTo errHandler
.Name = "ExterneDaten_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Else
MsgBox "Datei fehlt"
End If
End If
Exit Sub
errHandler:
MsgBox "Datei nicht gefunden, bitte richtigen pfad eingeben"
'Hinweis alle 15 Minuten
Application.OnTime Now + TimeSerial(0, 15, 0), "Aufforderung"
Startzeit = Now + TimeSerial(0, 15, 0)
End Sub
und diese Code habe ich in "DieseArbeitsmappe" eingefügt:
Private Sub Workbook_Open()
Start = True
Call Aufforderung
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
'nach dem Schließen der Datei die Prozedur nicht mehr aufrufen
Application.OnTime EarliestTime:=Startzeit, Procedure:="Aufforderung", Schedule:=False
End Sub