MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 14.03.2018, 12:07   #1
Vebegianer
Neuer Benutzer
Neuer Benutzer
Top Acc2016 - Import aus Excel-Datei Fehler in konvertierter Datenbank

In meiner Datenbank funktioniert nach der Umstellung auf Access 2016 der Import einer Excel-Datei nicht mehr. Die Excel-Datei ist für den Import geöffnet, wir aber mit der Fehlermeldung "Fehler in cmd_Import_Click : 1004 Wir konnten '' nicht finden. Wurde das Objekt vielleicht verschoben, umbenannt oder gelöscht?" nicht importiert. Ich habe den Code jetzt bereits mehrfach verändert, komme aber nicht weiter. GRRRR

Vielleicht findet jemand auf Anhieb den Fehler. Denke es ist nur eine Kleinigkeit, aber ich finde den Fehler nicht....

Hier der VBA-Code:
Code:

Private Sub cmd_Import_Click()
On Error GoTo err_cmd_Import_Click

    Dim fso                  	As New Scripting.FileSystemObject
    Dim appExcel           	As Excel.Application
    Dim anyWb            	As Excel.Workbook 
    Dim myWb           		As Excel.Workbook
    Dim anyWs               	As Excel.Worksheet
    Dim myWs                	As Excel.Worksheet
    Dim x               		As Long
    Dim y                   		As Long
    Dim I                   		As Long
    Dim Vorhanden       	As Boolean
    Dim Filename           	As String
    Dim PM                         As Parameter
    Dim NameTempl     	As String
    Dim RS1                 	As DAO.Recordset
    Dim rs2                		As DAO.Recordset
    Dim Query               	As String
    Dim maxColumnsToCopy    As Long
    Dim SQL                 	As String
    Dim NewSheet
    Dim N
    Dim rng

    WriteLogfile ("Prüfe Informationen für den Sammel Import ...")
    
    If Not IsDate(Me.txt_Eingangsdatum) Then
        MsgBox "Sie haben ein ungültiges Eingangsdatum eingetragen." & vbCrLf & "Eingabe bitte wiederholen", vbInformation, "Sicherheitshinweis"
        Me.txt_Eingangsdatum.SetFocus
        Exit Sub
    End If
    
    If CDate(Me.txt_Eingangsdatum) > DateAdd("d", 7, Date) Then
        MsgBox "Sie haben ein Eingangsdatum aus der Zukunft eingetragen." & vbCrLf & "Dies ist gegenwärtig nicht vorgesehen." & vbCrLf & "Eingabe bitte wiederholen", vbInformation, "Sicherheitshinweis"
        Me.txt_Eingangsdatum.SetFocus
        Exit Sub
    End If
    
    If Me.cbo_Artikelbezeichnung = 0 Then
        MsgBox "Sie haben eine Artikelbezeichnung ausgewählt, die eine ungültige Artikelnummer hinterlegt hat." & vbCrLf & "Eingabe bitte korrigieren.", vbInformation, "Sicherheithinweis"
        Me.cbo_Artikelbezeichnung.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.cbo_Artikelnummer) Or Me.cbo_Artikelnummer = 0 Then
        MsgBox "Sie haben eine ungültige Artikelnummer ausgewählt." & vbCrLf & "Eingabe bitte korrigieren.", vbInformation, "Sicherheithinweis"
        Me.cbo_Artikelnummer.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.cbo_Hersteller) Then
        MsgBox "Sie haben noch keinen Artikelhersteller eingetragen." & vbCrLf & "Eingabe bitte wiederholen.", vbInformation, "Sicherheitshinweis"
        Me.cbo_Hersteller.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.cbo_Auftraggeber) Or Me.cbo_Auftraggeber = 0 Then
        MsgBox "Sie haben einen ungültigen Auftraggeber ausgewählt." & _
            vbCrLf & "Bitte Auftraggebernummer eintragen.", vbInformation, "Sicherheitshinweis"
        Me.cbo_Auftraggeber.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.cbo_Auftraggebernummer) Or Me.cbo_Auftraggebernummer = 0 Then
        MsgBox "Sie haben einen ungültigen Auftraggeber ausgewählt." & _
            vbCrLf & "Bitte Auftraggebernummer eintragen.", vbInformation, "Sicherheitshinweis"
        Me.cbo_Auftraggebernummer.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me.cbo_Lagerort) Then
        MsgBox "Sie haben keinen Lagerort eingetragen." & vbCrLf & "Eingabe wiederholen.", vbInformation, "Sicherheitshinweis"
        Me.cbo_Lagerort.SetFocus
        Exit Sub
    End If
    
    'If Me.txt_Losnummer = Null Then
    '    MsgBox "Sie haben keine Losnummer eingetragen." & vbCrLf & "Eingabe wiederholen", vbInformation, "Sicherheitshinweis"
    '    Me.txt_Losnummer.SetFocus
    '    Exit Sub
    'End If
    
    If IsNull(Me.txt_Erlaubnis) Then
        MsgBox "Sie haben keinen Erlaubnistyp eingetragen." & vbCrLf & "Eingabe wiederholen.", vbInformation, "Sicherheitshinweis"
        Me.txt_Erlaubnis.SetFocus
        Exit Sub
    End If

    WriteLogfile ("Importdatei wird geöffnet ...")
    Quelldatei = DateiOeffnen("Datei öffnen", "Excel-Sheet" & Chr$(0) & "*.XLS")


    If Me.opt_Aktiv Then
        WriteLogfile ("Die Datei " & Quelldatei & " (Losnummer: " & Me.txt_Losnummer & " wurde mit AktiveFlag importiert...")
    Else
        WriteLogfile ("Die Datei " & Quelldatei & " (Losnummer: " & Me.txt_Losnummer & " wurde ohne AktiveFlag importiert...")
    End If

    Filename = Quelldatei
    On Error Resume Next
    Set appExcel = GetObject(, "Excel.Application")
    If err.Number <> 0 Then ' Excel noch nicht geöffnet
        'On Error GoTo Err_Excel_Export
        Set appExcel = CreateObject("Excel.Application")
    Else
        'On Error GoTo Err_Excel_Export
    End If
    On Error GoTo err_cmd_Import_Click
    If Not appExcel.Visible Then appExcel.Visible = True
    
    appExcel.DisplayAlerts = True

    ' Existiert Sheet in Source-Workbook
    ' Application.Echo True, NameTempl & " Export - Checking template..."
    appExcel.Workbooks.Open Quelldatei, False, False
    For Each anyWb In appExcel.Workbooks
        If anyWb.Name = fso.getFilename(Quelldatei) Then
            Set myWb = anyWb
        End If
    Next
     For Each anyWs In myWb.Worksheets
            Set myWs = anyWs
     Next
    
    Vorhanden = False
    myWs.Activate

    myWb.Sheets("Tabelle1").Select
    Range("A1").Activate
    Range("A1").Select
    Range("A65536").End(xlUp).Offset(0, 0).Select
    
    Dim Lastadress
    Lastadress = ActiveCell.Address
    Range("A1").Activate
    Range("A1").Select
    
    Application.SysCmd acSysCmdSetStatus, "Lesen der Artikelnummern aus der Exceltabelle...."
    Set RS1 = CurrentDb.OpenRecordset("tbl_Artikelbuch")
    For I = 0 To CLng(Mid(Lastadress, InStr(2, Lastadress, "$") + 1)) - 1
        ' Nummer schreiben
        ' Hier kann mit einem Formatbefehl das entsprechende Format eingestellt werden
        ' Nummer = format(ActiveCell.Offset(I, 0).value,"X XXX XXX")
        RS1.AddNew
        
        RS1![Erfassungdatum] = Date
        RS1![Ueberlassungsdatum] = Me.txt_Eingangsdatum
        RS1![MatGrp] = CLng(Me.cbo_Artikelnummer.Column(1))
        RS1![Artikelnummer] = Me.cbo_Artikelbezeichnung.Column(0)
        RS1![Firma] = Me.cbo_Hersteller
        RS1![Herstellernummer] = ActiveCell.Offset(I, 0).value
        RS1![Auftraggeber] = Me.cbo_Auftraggeber.Column(0)
        RS1![LosNummer] = IIf(IsNull(Me.txt_Losnummer), "", Me.txt_Losnummer)
        RS1![KdNr] = 999999
        RS1![Aktiv] = Me.opt_Aktiv
        RS1![Lagerort] = Me.cbo_Lagerort
        RS1![Erlaubnis] = Me.txt_Erlaubnis
        RS1.Update
        
        Application.SysCmd acSysCmdSetStatus, "Lesen der Artikelnummern aus der Exceltabelle....(Zeile : " & CStr(I + 2) & " von : " & Mid(Lastadress, InStr(2, Lastadress, "$") + 1) & ")"
    Next I
    
    Application.SysCmd acSysCmdSetStatus, "Excelsheet wird geschlossen...."
    ' myWb.Save
    myWb.Close
    Set myWb = Nothing
    MsgBox "Der Import wurde erfolgreich durchgeführt..." & _
    vbCrLf & "Es wurden " & CLng(Mid(Lastadress, InStr(2, Lastadress, "$") + 1)) & " Sätze gelesen..", vbInformation, "Sicherheitshinweis"
    
    WriteLogfile ("Sammel Import ordnungsgemäß durchgeführt.")
    
    Application.SysCmd acSysCmdClearStatus

exit_cmd_Import_Click:
Exit Sub

err_cmd_Import_Click:
WriteLogfile ("Fehler in cmd_Import_Click : " & err.Number & " " & err.Description)
MsgBox "Der Import wurde aufgrund eines Fehlers abgebrochen...", vbInformation, "Sicherheitshinweis"
Resume exit_cmd_Import_Click

End Sub

Hoffe auf tatkräftige Unterstützung!!!

Vielen Dank vorab für eure Hilfe

Geändert von TommyK (17.03.2018 um 08:26 Uhr). Grund: VBA Tag gesetzt
Vebegianer ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.03.2018, 08:05   #2
hcscherzer
MOF Guru
MOF Guru
Standard

Moin.
Dein Beitrag gehört nun wirklich nicht ins Code-Archiv.
Lies bitte mal die Richtlinien durch.

Du solltest einen Admin bitten, ihn in das "normale" Access-Forum zu verschieben.
Und so viel Code ohne Einrückungen der Kontrollstrukturen und ohne ihn in Tags zu kleiden ... da kann ich Dir nicht viel Hoffnung machen, dass sich jemand damit befasst ... vielleicht kannst Du das ja noch ändern?

__________________

Freundlichen Gruß
Hans-Christian
-----------------------------------------
Oft erwünscht, selten beachtet: nach Erledigung des Problems den Thread als erledigt zu markieren
-----------------------------------------
Ich möchte nur Mitglied in einem Verein sein, der Leute wie mich nicht als Mitglied aufnimmt (Groucho Marx).
-----------------------------------------
Ab sofort regelmässig: MOF Stammtisch in Bremen. Näheres hier.
hcscherzer ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.03.2018, 08:16   #3
Vebegianer
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Strahlen Danke :)

Danke für die Info. Da Habe ich wohl nicht genau gelesen und werde die Admins mal anschreiben
.
Werde es versuchen anzupassen
Vebegianer ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:40 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.