Supportnet Computer
Planet of Tech

Supportnet / Forum / Datenbanken

Textfile in Datenbank importieren





Frage

Hy Folks ! Ich möchte ein Textfile(Zahlenreihe) in eine Datenbank importieren, es existieren mehrere Textfiles mit der gleichen Strucktur.. Tabstopgetrennt, sehen so aus: [code] 0.1312312 1.23133 2.4444444 2.54535 . . . . ...and so on. [/code] Das ganze soll zur Laufzeit geschehen, ich betätige einen Button, und der commDialog öffnet sich (so weit sind wir schon). Jetzt kommt aber der Clou, der nicht will und von dem ich keineAhnung habe, was passiert wenn ich jetzt die Textdatei anklicke, und wie kriege ich sie geöffnet, und in eine Tabelle importiert (Get, Put ?) ??? Da gibt es doch bestimmt schon vorgefertigten Quellcode den man abändern kann, oder ? Thanx

Antwort 1 von Coolpix

hi BC,

es gibt da mehrere Möglichkeiten hier die nach meiner Meinung simpelste:

zunächst importierst du ein
Textfile manuell. Wenn du alle Einstellungen bezüglich Spaltenköpfen, Trennzeichen , Zahlenformaten getroffen hast klickst du unten auf den Button Weitere...
Dort kannst du deine Importspezifikationen für diese Art Textfile Speichern.

Einmal importieren zum Test und dann Tabelle wieder löschen ;-)

Nun in den Makroeditor:

Dort erstellst du ein neues Makro:

wählst in der ersten Zeile die Funktion "TransferText"

am unteren Bildschirmrand kannst du jetzt die Parameter der Funktion einstellen:

Transfer Typ : Import festgelegtes Format
Spezifikationsname: Deine eben angelegte Spezifikation.
Tabellenname: es empfiehlt sich eine temporäre Tabelle (z.B. tblTemp) zu nehmen und die Daten daraus weiterzuleiten

Dateiname: Einmal zu Testzwecken der ganaue Pfad(z.B. C:\temp\test.txt)
Besitzt Feldnamen: Nur wenn deine Textdatei Spaltenüberschriften hat.

so... Makro speichern und dann...
im Datenbankfenster das Makro mit einem Klick markieren und im Menü EXTRAS->MAKRO den Befehl "Makros zu VBA konvertieren" wählen.
Access erstellt dir neues Modul mit dem VBA-Code deines Makros.

Sieht ungefär so aus:

Function Makro2()
On Error GoTo Makro2_Err

    DoCmd.TransferText acImportFixed, "Test Importspezifikation", "tblTemp", "c:\temp\test.txt", False, "" 
'was hier in Anführungszeichen steht kann man durch Variablen ersetzen :)


Makro2_Exit:
    Exit Function

Makro2_Err:
    MsgBox Error$
    Resume Makro2_Exit

End Function



wenn du das jetzt mit ein Paar Variablen Pfad,Dateinamen ... anpasst kannst du alle deine Textfiles importieren.

Tipp:
ich würde wie oben erwähnt nacheinander ein Textfile in eine tblTemp importieren und dann , je nach Bedarf per Aktualisierung / Anfügeabfrage in die Zieltabelle schreiben

Greetings ;-)





Antwort 2 von BenztownCitizen

Hallo !

Das mit dem Import ist ne feine Sache, aber....
Kannst Du mir verraten warum er beim Importieren alles richtig macht, und wenn ich später (gleicher Text, Importspezifikatin abgespeichert)
das ganze über das Makro mache, er mir entweder die ersten Zahlen gar nicht anzeigt, und wenn ich dann das ganze in Text mache, sind die Leerzeichen als kleine Vierecke dargestellt...


http://sabecker.at.interims.de/tables.doc


Textdatei:

http://sabecker.at.interims.de/test%2Etxt


1.Tab = Importiert über Importfunktion
2. + 3. Tab = Mit Makro + Importspezifikation, unterschiedliche Datentypen(habe ich in Zeilenüberschrift geschrieben zur Übersicht).

(Die zweite Spalte muß ich als Text importieren, da das Komma im Textfile durch einen Punkt dargestellt wird, den er bei allen anderen Formaten einfach rausschneidet.)

So ist das... Verstehe ich auch nicht das er es einwandfrei beim Import macht, und dann mit der gleichen, abgespeicherten Spezifikation, Fehler einbaut ???

Gruß

Antwort 3 von Coolpix

hi BC,

wie gesagt es gibt mehrere Möglichkeiten.
Eine andere wäre das Ganze per OpenFile for Input
einzulesen und dann Per Recordset-Add in die Tabelle zu schreiben.

Ich bin da schon was am vorbereiten, bräuchte aber dene Mailadresse ums dir zuzuschicken.
Is echt n' bisschen komplex...

...@ SN werde den Code dann auch hier posten :)

Greetings ;-)

Antwort 4 von Coolpix

hallo nochmal,

hier der versprochene Code:

hier eine kleine Prozedur welche den Inhalt
der in der Datenbank vorhandenen tblTemp löscht...
die Datei test.txt aus dem Datenbankpfad zeilenweise einliest und nur die
Zeilen in die tblTemp schreibt, die als erstes Zeichen eine Zahl haben.


Public Sub ImportTXT()
'In Menü Extras-Verweise muß ei Häckchen vor
'Microsoft DAO 3.6 Object Library gesetzt sein !!

Dim DB       As DAO.Database
Dim RS       As DAO.Recordset
Dim Datei    As String
Dim Wert     As String

    Datei = Application.CurrentProject.Path & "\test.txt"    'Textfile befindet sich im aktuellen Datenbankpfad

    Set DB = CurrentDb()
    Set RS = DB.OpenRecordset("tblTemp", dbOpenDynaset)

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    DoCmd.SetWarnings False    'Warnmeldung aus
    DoCmd.RunSQL "DELETE * FROM tblTemp;"    'Leeren der Tabelle tblTemp
    DoCmd.SetWarnings True    'Warnmeldung an
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Close #1    ' Pipe1 schließen falls noch offen
    Open Datei For Input As #1    'Datei auf Pipe1 öffnen

    Do While Not EOF(1)    'Schleife solange Datei in Pipe1 nicht zu Ende ist
        Line Input #1, Wert    'Zeile in Variable Wert einlesen
        If IsNumeric(VBA.Mid(Wert, 1, 1)) = True Then    'Prüfung ob das erste Zeichen in der Variablen numerisch ist

            With RS
                .AddNew    'neuen Datensatz hinzufügen
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was davor steht
                .Fields("Feld1") = VBA.Mid(Wert, 1, (VBA.InStr(1, Wert, vbTab) - 1))
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was dahinter steht
                .Fields("Feld2") = VBA.Mid(Wert, (VBA.InStr(1, Wert, vbTab) + 1), VBA.Len(Wert) - VBA.InStr(1, Wert, vbTab))
                'Datensatz in Tabelle sichern
                .Update
            End With
        End If

    Loop
    RS.Close
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

End Sub




Greetings ;-)

Antwort 5 von BenztownCitizen

Hallo Coolpix !

Das Ding ist echt der Hammer, nun muß man das Teil noch so abändern, das als Dateiname die Variable des commDialogs übergeben wird.


Option Compare Database
Option Explicit

Type ACB_OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

Declare Function API_DateiOeffnen Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As ACB_OPENFILENAME) As Long

Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10

Dim pOpenfilename As ACB_OPENFILENAME




Function dialogOpenFile(strVerzeichnis As String, strTitel As String, isPDF As Boolean) As String
    
    Dim strFilter As String
    Dim strDateinameUndPfad As String
    Dim strDateiname As String
    Dim lngErgebnis As Long

' Angebotene Dateifilter in der Dropdownliste "Dateityp"

    strFilter = "EMCtech Textdatei (*.*)" & Chr$(0) & "*.*" & Chr$(0)

    
' Vorgegebenes Verzeichnis
    If strVerzeichnis = "" Then
        
        strVerzeichnis = strVerzeichnis & Chr$(0) ' Wenn leer, dann das aktuelle Verzeichnis verwenden
    Else
        strVerzeichnis = strVerzeichnis & Chr$(0) ' ANSI "0" an übergebenes Verzeichnis anhängen
    End If
    
    If strTitel = "" Then
        strTitel = "Devices open file" ' Wenn kein Titel übergeben, Standardtitel festlegen
    Else
        strTitel = strTitel & Chr$(0) ' ANSI "0" an übergebenen Titel anhängen
    End If

' Speicherplatz für Dateinamen & Pfad reservieren
    strDateinameUndPfad = Space$(255) & Chr$(0)
    
' Speicherplatz für Dateinamen ohne Pfad reservieren
    strDateiname = Space$(255) & Chr$(0)

'Datenstruktur von pOPENFILENAME festlegen

    pOpenfilename.lStructSize = Len(pOpenfilename)
    pOpenfilename.hwndOwner = 0&
    'pOpenfilename.hwndOwner = Application.hWndAccessApp
    pOpenfilename.lpstrFilter = strFilter
    pOpenfilename.nFilterIndex = 1
    pOpenfilename.lpstrFile = strDateinameUndPfad
    pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
    pOpenfilename.lpstrFileTitle = strDateiname
    pOpenfilename.nMaxFileTitle = Len(strDateiname)
    pOpenfilename.lpstrInitialDir = strVerzeichnis
    pOpenfilename.lpstrTitle = strTitel
    pOpenfilename.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
    pOpenfilename.nFileOffset = 0
    pOpenfilename.nFileExtension = 0
    pOpenfilename.lCustData = 0
    pOpenfilename.lpfnHook = 0
    pOpenfilename.lpTemplateName = ""

    lngErgebnis = API_DateiOeffnen(pOpenfilename)

    If lngErgebnis <> 0 Then
        dialogOpenFile = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) - 1)
    Else
        dialogOpenFile = ""
    End If


End Function


Public Sub openfile()

   Dim pathDat As String
   Dim pos As Integer
   Dim str As String
   
 
pathDat = dialogOpenFile("", "", False)

If Len(pathDat) > 0 Then
    pos = InStr(1, pathDat, "protocol", 1) - 1
    
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
End Sub


Das währe dann perfekt


Gruß, und vielen Dank

BC

Antwort 6 von Coolpix

hi nochmal,
check this !



Option Compare Database
Option Explicit
Public pathDat As String

Type ACB_OPENFILENAME
    lStructSize  As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags    As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function API_DateiOeffnen Lib "comdlg32.dll" Alias _
        "GetOpenFileNameA" (pOpenfilename As ACB_OPENFILENAME) As Long

Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10

Dim pOpenfilename As ACB_OPENFILENAME





Function dialogOpenFile(strVerzeichnis As String, strTitel As String, isPDF As Boolean) As String
    
    Dim strFilter As String
    Dim strDateinameUndPfad As String
    Dim strDateiname As String
    Dim lngErgebnis As Long

' Angebotene Dateifilter in der Dropdownliste "Dateityp"

    strFilter = "EMCtech Textdatei (*.*)" & Chr$(0) & "*.*" & Chr$(0)

    
' Vorgegebenes Verzeichnis
    If strVerzeichnis = "" Then
        
        strVerzeichnis = strVerzeichnis & Chr$(0) ' Wenn leer, dann das aktuelle Verzeichnis verwenden
    Else
        strVerzeichnis = strVerzeichnis & Chr$(0) ' ANSI "0" an übergebenes Verzeichnis anhängen
    End If
    
    If strTitel = "" Then
        strTitel = "Devices open file" ' Wenn kein Titel übergeben, Standardtitel festlegen
    Else
        strTitel = strTitel & Chr$(0) ' ANSI "0" an übergebenen Titel anhängen
    End If

' Speicherplatz für Dateinamen & Pfad reservieren
    strDateinameUndPfad = Space$(255) & Chr$(0)
    
' Speicherplatz für Dateinamen ohne Pfad reservieren
    strDateiname = Space$(255) & Chr$(0)

'Datenstruktur von pOPENFILENAME festlegen

    pOpenfilename.lStructSize = Len(pOpenfilename)
    pOpenfilename.hwndOwner = 0&
    'pOpenfilename.hwndOwner = Application.hWndAccessApp
    pOpenfilename.lpstrFilter = strFilter
    pOpenfilename.nFilterIndex = 1
    pOpenfilename.lpstrFile = strDateinameUndPfad
    pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
    pOpenfilename.lpstrFileTitle = strDateiname
    pOpenfilename.nMaxFileTitle = Len(strDateiname)
    pOpenfilename.lpstrInitialDir = strVerzeichnis
    pOpenfilename.lpstrTitle = strTitel
    pOpenfilename.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
    pOpenfilename.nFileOffset = 0
    pOpenfilename.nFileExtension = 0
    pOpenfilename.lCustData = 0
    pOpenfilename.lpfnHook = 0
    pOpenfilename.lpTemplateName = ""

    lngErgebnis = API_DateiOeffnen(pOpenfilename)

    If lngErgebnis <> 0 Then
        dialogOpenFile = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) - 1)
    Else
        dialogOpenFile = ""
    End If


End Function


Public Sub openfile()

'   Dim pathDat As String 'Pfad in Deklarationsbereich des Moduls verschoben
   Dim pos As Integer
   Dim str As String
   
 
pathDat = dialogOpenFile("", "", False)

If Len(pathDat) > 0 Then
    pos = InStr(1, pathDat, "protocol", 1) - 1
Call ImportTXT
End If

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
End Sub
Public Sub ImportTXT()
'In Menü Extras-Verweise muß ei Häckchen vor
'Microsoft DAO 3.6 Object Library gesetzt sein !!

Dim DB       As DAO.Database
Dim RS       As DAO.Recordset
Dim Datei    As String
Dim Wert     As String

'    Datei = Application.CurrentProject.Path & "\test.txt"    'Textfile befindet sich im aktuellen Datenbankpfad
    Datei = pathDat
    Set DB = CurrentDb()
    Set RS = DB.OpenRecordset("tblTemp", dbOpenDynaset)

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    DoCmd.SetWarnings False    'Warnmeldung aus
    DoCmd.RunSQL "DELETE * FROM tblTemp;"    'Leeren der Tabelle tblTemp
    DoCmd.SetWarnings True    'Warnmeldung an
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Close #1    ' Pipe1 schließen falls noch offen
    Open Datei For Input As #1    'Datei auf Pipe1 öffnen

    Do While Not EOF(1)    'Schleife solange Datei in Pipe1 nicht zu Ende ist
        Line Input #1, Wert    'Zeile in Variable Wert einlesen
        If IsNumeric(VBA.Mid(Wert, 1, 1)) = True Then    'Prüfung ob das erste Zeichen in der Variablen numerisch ist

            With RS
                .AddNew    'neuen Datensatz hinzufügen
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was davor steht
                .Fields("Feld1") = VBA.Mid(Wert, 1, (VBA.InStr(1, Wert, vbTab) - 1))
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was dahinter steht
                .Fields("Feld2") = VBA.Mid(Wert, (VBA.InStr(1, Wert, vbTab) + 1), VBA.Len(Wert) - VBA.InStr(1, Wert, vbTab))
                'Datensatz in Tabelle sichern
                .Update
            End With
        End If

    Loop
    RS.Close
    Set RS = Nothing
    DB.Close
    Set DB = Nothing

End Sub


Greetings ;-)

Antwort 7 von BenztownCitizen

Hy Coolpix

Das Ding funktioniert echt super !

Ist schon Toll das sich im SN wirklich fähige Leute zu Wort melden.

Thanx

BC

Antwort 8 von BenztownCitizen

Hy !

Hab noch ein paar Ergänzungen im Mittelteil gemacht...


 Do While Not EOF(1)    'Schleife solange Datei in Pipe1 nicht zu Ende ist
        Line Input #1, wert    'Zeile in Variable Wert einlesen
         wert = LTrim(wert)  'Führende Leerzeichen, welche als String erkannt werden entfernen
        If IsNumeric(VBA.Mid(wert, 1, 1)) = True Then    'Prüfung ob das erste Zeichen in der Variablen numerisch ist
                 j = j + 1
             i = InStr(UCase(wert), ".")   'Punkt durch Komma ersetzen
                 If i > 0 Then
                 wert = replace(wert, ".", ",")
                 End If
              
             With RS
                .AddNew    'neuen Datensatz hinzufügen
                .Fields("ID") = j
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was davor steht
                .Fields("Feld1") = VBA.Mid(wert, 1, (VBA.InStr(1, wert, vbTab) - 1))
                'suche in Wert nach der Stelle des Tab-Zeichens und schreibe in Feld1 alles was dahinter steht
                .Fields("Feld2") = VBA.Mid(wert, (VBA.InStr(1, wert, vbTab) + 1), VBA.Len(wert) - VBA.InStr(1, wert, vbTab))
                'Datensatz in Tabelle sichern
                .Update
            End With
        End If


1. Es gibt Textfiles die beginnen mit zwei bis drei Leerzeichen, die er dann als String erkennt und vorzeitig aus der Prozedur springt, und diese Zahlen nicht übernimmt.

2. Die Zahlen in den Textfiles haben einen Punkt statt Komma, was den Tabelleneintrag als Double nicht zulässt.

3.Wollte ich keinen AutoWert sondern eine laufende Nummer als ID

Die Analyse ursprüngliche Quelltextes hat mich weitergebracht, so das ich nicht wegen jeder Kleinigkeit fragen muß.

Gruß

BC

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: