Access Import mit festen oder freien Spalten

Date 10.03.2019

Kann man mit Access dynamische Dateien einlesen anhand der Kopfzeilen?

Antwort : nur via Excel

Ja:

Mit Excel als Daten-Austausch-Dateien ist die Position der Spalte egal,

Nein:

Mit .csv Dateien mit semikolon ; als Trennzeichen muss leider immer genau die Position in der sogenannten Importfilter-Specification definiert werden

Mit .txt FixedImport ist sogar die Zeichenlänge bestimmt

Beim Import mit MS Access kann man folgende Import-Formate einstellen

TransferType:
acImportDelim ->mit Semikolon festgelegt

acImportFixed ->Feste Anzahl Zeichen pro Feld also ID=10 Zeichen, dann Name=25 Zeichen

acImportHTML ->als HTML

Import mit ; Semikolon getrenneten CSV Dateien

DoCmd.TransferText acImportDelim, "my_Import_specification _UTF8_" & sTyp, sImport_Tablename, sDatei_mitPfad, True

Hier wird jede Spalte genau definiert und muss in einer definierten Reihenfolge vorhanden sein.

'=========================< #region: Import >=========================

Private Function fl_Import_to_Buffer(ByVal sDateiname As String, ByVal sTyp As String, ByVal intIDImport As Long) As Long

'----< Funktion : Datei importieren >----

addStep "< Import : Start >"

'default returnwert

fl_Import_to_Buffer = 0

'< Kontrolle >

If sDateiname Like "" Then

MsgBox "es ist keine Importdatei angegeben", vbCritical, "fl_Import_to_Buffer()"

Exit Function

End If

'</ Kontrolle >

'< init >

Dim sDatei_mitPfad As String

sDatei_mitPfad = tbxPfad_Ordner & sDateiname

'</ init >

addStep "import: Datei=" & sDateiname

'< Kopf ermitteln >

addLog "ermittle Berichtskopf"

Dim rMaster As Recordset

Set rMaster = CurrentDb.OpenRecordset("SELECT TOP 1 * FROM tbl_" & sTyp & "_MasterFiles WHERE IDImport_" & sTyp & "_File=" & intIDImport)

If Not rMaster.EOF Then

addStep "überschreiben"

rMaster.Edit

Else

addStep "neu"

rMaster.AddNew

End If

rMaster!dtImport = Now

rMaster!Filename = sDateiname

rMaster!FileLong = sDatei_mitPfad

rMaster.Update

rMaster.MoveLast

°IDImport = rMaster("IDImport_" & sTyp & "_File")

rMaster.Close

'< Kopf ermitteln >

'< reset >

Dim sImport_Tablename As String

sImport_Tablename = "_Import_" & sTyp

addLog "reset Importpuffer"

CurrentDb.Execute "DELETE * FROM " & sImport_Tablename

'</ reset >

On Error Resume Next

'----< Import csv Datei mit Umlauten >----

DoCmd.TransferText acImportDelim, "my_Import_specification _UTF8_" & sTyp, sImport_Tablename, sDatei_mitPfad, True

'----</ Import csv Datei mit Umlauten >----

If Err.Number <> 0 Then

MsgBox Err.Description & sAbbruch, vbCritical, "Fehler beim Import von Excel"

°IDImport = 0

Exit Function

End If

addLog "Import in Puffer: ok"

'</ Import Details >

'< Anzeigen >

ctlListe_Imported.Requery

fl_Import_to_Buffer = °IDImport

addStep "</ Import : Stop >"

'</ Anzeigen >

'----</ Funktion : Datei importieren >----

End Function

Access Datei-Import mit automatischer Zuordnung anhand der ersten Zeile mit Header

DoCmd.TransferSpreadsheet acImport, , "_Import_" & °Area & "_Daten", sDatei_Pfad, True

Code-Beispiel

'=========================< #region: Import >=========================

Private Function fxImportieren() As Boolean

'----< Funktion : Datei importieren >----

addStep "< Import : Start >"

'return=0

fxImportieren = False

'< Kontrolle >

If IsNull(ctlListe_Import.Column(0)) Then

MsgBox "es ist keine Importdatei markiert", vbCritical, "Kontrolle Datei"

Exit Function

End If

'</ Kontrolle >

'< init >

Dim dtReport As Date

Dim sDatei_Pfad As String, sDateiname As String

Dim sJahr As String, sMonat As String

Dim sAbbruch As String

Dim sOrganisation As String

dtReport = ctldtReport

sJahr = Year(ctldtReport) '4stellen

sMonat = Format(Month(dtReport), "00")

sDateiname = ctlListe_Import.Column(0)

sDatei_Pfad = tbxPfad_Ordner & sDateiname

sAbbruch = vbCrLf & "Der Vorgang wird abgebrochen."

sOrganisation = ctlOrganisation

'</ init >

'< Kontrolle Dateiname >

addLog "prüfe Dateikennungen.."

If optNamenskontrolle = -1 Then

Dim sFilelong As String

sFilelong = sDatei_Pfad & "\" & sDateiname

'< Jahr >

Dim intPosJahr As Integer

intPosJahr = InStr(1, sFilelong, sJahr, vbTextCompare)

If Not intPosJahr > 0 Then

MsgBox "Der Import-Dateiname " & sDateiname & " enthält nicht die Jahreskennung " & sJahr & sAbbruch, vbCritical, "Abbruch Import: Kontrolle Dateikennung"

Exit Function

End If

'</ Jahr >

'< Monat >

'*rechts vom Jahr

If Not InStr(intPosJahr + 4, sFilelong, sMonat, vbTextCompare) > 0 Then

'*Links vom Jahr

If Not InStrRev(sFilelong, sMonat, intPosJahr, vbTextCompare) > 0 Then

MsgBox "Der Import-Dateiname " & sDateiname & " enthält nicht die Monatskennung " & sMonat & sAbbruch, vbCritical, "Abbruch Import: Kontrolle Dateikennung"

Exit Function

End If

'</ Monat >

End If

'</ Kontrolle Dateiname >

addStep "import: dtReport=" & dtReport

addStep "import: Datei=" & sDateiname

'< Kopf ermitteln >

addLog "ermittle Berichtskopf"

Dim rMaster As Recordset

Set rMaster = CurrentDb.OpenRecordset("SELECT TOP 1 * FROM tbl_RF_Master WHERE IDReport = " & °IDMaster)

If rMaster.EOF Then

addStep "neu"

rMaster.AddNew

Else

addStep "überschreiben"

rMaster.Edit

End If

rMaster!dtReport = dtReport

rMaster!dtImport = Now

rMaster!Organisation = sOrganisation

rMaster!Filename = sDateiname

rMaster!FileLong = sDatei_Pfad

rMaster.Update

rMaster.MoveLast

°IDMaster = rMaster!IDReport

rMaster.Close

addStep "IDReport=" & °IDMaster

'< Kopf ermitteln >

'< reset >

addLog "reset Importpuffer"

CurrentDb.Execute "DELETE * FROM _Import_" & °Area & "_Daten"

'=qryImport_Act_00a_temp_reset

'</ reset >

'< Import Details>

addLog "Importiere Excel-Datei in Puffer : start"

On Error Resume Next

DoCmd.TransferSpreadsheet acImport, , "_Import_" & °Area & "_Daten", sDatei_Pfad, True

If Err.Number <> 0 Then

MsgBox Err.Description & sAbbruch, vbCritical, "Fehler beim Import von Excel"

Exit Function

End If

addLog "Import in Puffer: ok"

'</ Import Details >

'< Anzeigen >

ctlListe_vorhanden.Requery

addStep "</ Import >"

fxImportieren = True

'</ Anzeigen >

'----</ Funktion : Datei importieren >----

End Function

'=========================</ #region: Import >=========================