Sub TxtToAccess()

Dim i As Integer, dosya As Variant, txtdizin As String, kayit1 As String

txtdizin = "C:\TXTToAccess" 'Text Dosyalarının Olduğu Konum

Dim conn As Object

Dim RsTxt As Object

Set conn = CreateObject("ADODB.Connection")

        With conn

            .Provider = "Microsoft.JET.OLEDB.4.0"

            .Open txtdizin & "\TxtToAccess.mdb" ' Veri Tabanı Olduğu Dizn

        End With

    

            Set RsTxt = CreateObject("ADODB.RECORDSET")

            RsTxt.Open "SELECT * FROM TxtToAccess", conn, 1, 3



    ChDir (txtdizin) ' Text Dosyalarının Olduğu Konum

    dosya = Dir("*.txt")

While dosya <> ""

    Open txtdizin & "\" & dosya For Input As 1

        Do While Not EOF(1)

            Line Input #1, kayit1

            If kayit1 <> Empty Then

            bolstr = ""

            bolstr = Split(kayit1, ";")

            x = 0

            RsTxt.AddNew

                    For x = 0 To UBound(bolstr)

                        RsTxt.Fields(x + 1) = bolstr(x)

                    Next x

                RsTxt.Update

            End If

        Loop

    Close #1

    

    dosya = Dir

Wend

RsTxt.Close

            Set RsTxt = Nothing

            conn.Close

            Set conn = Nothing

End Sub