OK: Laufzeitfehler: -2147217887 (80040e21)
Fehlermeldung:
Laufzeitfehler: -2147217887 (80040e21) Fehler bei einem aus mehreren Schritten bestehenden Vorgang. Prüfen Sie die einzelnen Statuswerte. |
Ursache:
Der Fehler geschieht, wenn man in Microsoft Office (MS Access, Excel, Word, Powerpoint, Outlook) versucht in ein Datenbank Feld zuschreiben, und der String zu lang ist. adodb
Im Beispiel wird versucht in ein adodb Feld mit einer Länge von 50 Zeichen ein Filename mit mehr als 50 Zeichen zu speichern.
Lösung:
Feldlänge vergrösser
'< create_ado_Table > Dim sorted_List As ADODB.Recordset Set sorted_List = CreateObject("ADODB.Recordset") sorted_List.CursorLocation = 3 ' adUseClient sorted_List.Fields.Append "Status", 200, 50 ' adVarChar sorted_List.Fields.Append "FileName", 200, 50 ' adVarChar sorted_List.Fields.Append "FileDate", 200, 50 ' adVarChar sorted_List.Fields.Append "Date_Created", 7 ' adDate sorted_List.Open '</ create_ado_Table > .. .. '< add_line > sorted_List.AddNew sorted_List("Status").Value = "_Neu" sorted_List("FileName").Value = sFilename sorted_List("FileDate").Value = sFileDate sorted_List("Date_Created").Value = dtFile sorted_List.Update '</ add_line >
|
'============================< Funktionen >============================ Private Sub fl_Aktualisieren_Liste_Files_Folder() '------------< fl_Aktualisieren_Liste_Files_Folder() >------------ '*ermitteln der Dateien im Ordner und anzeigen
'< Init > Dim sPfad_Ordner As String sPfad_Ordner = tbxPfad_Ordner '< Init >
'< Korrekturen > If sPfad_Ordner Like "" Or IsNull(sPfad_Ordner) Then sPfad_Ordner = "c:\" sPfad_Ordner = Replace(sPfad_Ordner, "/", "\") If Not Right(sPfad_Ordner, 1) Like "\" Then sPfad_Ordner = sPfad_Ordner & "\" '</ Korrekturen >
On Error Resume Next ctlListe_Import.RowSource = ""
'--< Get_Folder >-- Dim objFileSystem As New FileSystemObject 'using Microsoft Scripting Runtime Dim objFolder As Folder Set objFolder = objFileSystem.GetFolder(sPfad_Ordner)
'< Kontrolle : Ordner > If Err.Number > 0 Then '< Standardordner > addLog Err.Description
sPfad_Ordner = CurrentProject.Path If Not Right(sPfad_Ordner, 1) Like "\" Then sPfad_Ordner = sPfad_Ordner & "\" Set objFolder = objFileSystem.GetFolder(sPfad_Ordner) On Error GoTo 0 '</ Standardordner > End If If objFolder Is Nothing Then Exit Sub End If '</ Kontrolle : Ordner > '--</ Get_Folder >-- addStatus "check files count:" & objFolder.Files.Count '----</ Files ermitteln >----
'< List_Header > ctlListe_Import.AddItem("Importstatus;File;FileDate;Date") '</ List_Header >
'< create_ado_Table > Dim sorted_List As ADODB.Recordset Set sorted_List = CreateObject("ADODB.Recordset") sorted_List.CursorLocation = 3 ' adUseClient sorted_List.Fields.Append "Status", 200, 50 ' adVarChar sorted_List.Fields.Append "FileName", 200, 50 ' adVarChar sorted_List.Fields.Append "FileDate", 200, 50 ' adVarChar sorted_List.Fields.Append "Date_Created", 7 ' adDate sorted_List.Open '</ create_ado_Table >
On Error GoTo 0 Dim objFile As File
For Each objFile In objFolder.Files Dim sFilename As String sFilename = objFile.Name
' '< Filter > ' Dim sFilter As String ' sFilter = ctlFilter.Value ' ' Dim arrWords ' arrWords = Split(sFilter) ' '</ Filter >
Dim posExtension As Integer posExtension = InStrRev(sFilename, ".")
Dim posStart As Integer posStart = InStrRev(sFilename, "_", posExtension) + 1
Dim sFileDate As String sFileDate = Mid(sFilename, posStart, posExtension - posStart)
Dim dtFile As String dtFile = objFile.DateCreated
Dim sDateFile As String sDateFile = objFile.DateCreated
If DateDiff("m", dtFile, Now) < 3 Then If sFilename Like "*.csv*" Then '---< ist_csv >--- If fl_Check_File_Is_Imported(sFilename) = False Then '< not imported > '< add_line > sorted_List.AddNew sorted_List("Status").Value = "_Neu" sorted_List("FileName").Value = sFilename sorted_List("FileDate").Value = sFileDate sorted_List("Date_Created").Value = dtFile sorted_List.Update '</ add_line > 'ctlListe_Import.AddItem ("_neu;" & sFilename & ";" & sDateFile) '</ not imported > Else '< is imported > If optZeige_neue_Dateien = 0 Then '< add_line > sorted_List.AddNew sorted_List("Status").Value = "_alt" sorted_List("FileName").Value = sFilename sorted_List("FileDate").Value = sFileDate sorted_List("Date_Created").Value = dtFile sorted_List.Update '</ add_line > 'ctlListe_Import.AddItem ("alt;" & sFilename & ";" & sDateFile) End If '</ is imported > End If '---</ ist_csv >--- End If End If Next '----< Files ermitteln >----
'< sort > sorted_List.Sort = "[Status] ASC,[FileDate] DESC" If Not sorted_List.EOF Then sorted_List.MoveFirst End If '</ sort >
'--< @Loop: Output >-- Do Until sorted_List.EOF ctlListe_Import.AddItem sorted_List("Status") & ";" & sorted_List("FileName") & ";" & sorted_List("FileDate") & ";" & sorted_List("Date_Created") sorted_List.MoveNext Loop
'< Abschluss > Set objFileSystem = Nothing Set objFile = Nothing Set objFolder = Nothing '</ Abschluss > '------------</ fl_Aktualisieren_Liste_Files_Folder() >------------ End Sub |