Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

OK: Laufzeitfehler: -2147217887 (80040e21)

16.09.2019 (👁12397)
OK: Laufzeitfehler: -2147217887 (80040e21)

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