Knop voor importeren

[kloer]

Beste lezers,

Wie kan mij helpen. Ik wil in mijn database een knop maken die een Excel werkblad importeerd en toevoegd aan een bestaande tabel. Hanmatig is dat voor mij geen probleem, maar ik kan in de macro editer niets vinden waarmee ik kan importeren.

Groetjes Klaas

 

[OctaFish]

Ik gebruik zoiets om een bestand met een semi-vaste naam te importeren:

Private Sub cmdImportRegulier_Click()
Dim DateStamp As String
Dim TempFilePath As String

    DateStamp = Format(date, "yymmdd")
    TempFilePath = Environ$("USERPROFILE") & "\"
    sFile = TempFilePath & "\Bureaublad\ImportRegulier " & DateStamp & ".xls"
    DoCmd.SetWarnings False
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ImportRegulier", sFile, True
    DoCmd.SetWarnings True

End Sub

Ik importeer altijd naar een eigen tabel, om dan in de volgende stap de geïmporteerde gegevens met een toevoegquery aan de echte tabel toe te voegen. Op die manier hou je de opmaak van je echte tabel intact.

 

[kloer]

Wat die ik fout?
De VBA wil niet werken?

Private Sub Knop2_Click()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strBrowseMsg = "Select the EXCEL file:"
strInitialDirectory = F:\COE-Database\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
strTable = "tablename"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames

End Sub

 

[OctaFish]

Wat die ik fout?

Je hebt de code niet opgemaakt met de CODE knop Graag alsnog doen...
En als je de code goed hebt gekopieerd, zit hier ook een fout.

    strInitialDirectory = [B][COLOR="#FF0000"]"[/COLOR][/B]F:\COE-Database\"

 

[kloer]

Hallo Michel,
Die fout heb ik zelf ook al gevonden, maar toch wil het niet werken.
Ik heb de vraag al op meerdere fora staan.

 

[OctaFish]

Ik gebruik jouw techniek niet, maar een andere, die wel werkt. Wellicht dat je daar dus meer aan hebt dan aan het oplappen van die van jou.

Private Sub cmdImport_Click()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFileName As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
Dim dlgPicker As FileDialog
Dim vrtSelectedItem As Variant
    
    blnHasFieldNames = True
    strBrowseMsg = "Select the EXCEL file:"
    strInitialDirectory = "F:\COE-Database\"
    Set dlgPicker = Application.FileDialog(msoFileDialogFilePicker)
    With dlgPicker
        .Title = strBrowseMsg  'De titel voor het venster
        .InitialFileName = strInitialDirectory       'Waar moet het venster beginnen?
        .InitialView = msoFileDialogViewList        'Bepaal weergave
        With .Filters
            .Clear
            .Add "Microsoft Excel", "*.xls; *.xlt", i + 1      'Beperk de bestandstypes tot .xls
        End With
        .FilterIndex = 1
        '**************************************************************************
        ' Variant voor één bestand
        '**************************************************************************
        .AllowMultiSelect = False                   'Slechts één bestand kiezen.
        If .Show = -1 Then                          'Bepaal of gebruiker op OK-knop heeft geklikt.
            strFileName = .SelectedItems.Item(1)    'String wordt gevuld met geselecteerde bestand
        Else
            MsgBox "Er is op <Cancel> gedrukt..."
        End If
''        '**************************************************************************
''        ' Variant voor meerdere bestanden
''        '**************************************************************************
''        .AllowMultiSelect = True                   'meerdere bestanden kiezen.
''        If .Show = -1 Then                          'Bepaal of gebruiker op OK-knop heeft geklikt.
''            For Each vrtSelectedItem In .SelectedItems
''                strFileName = strFileName & vrtSelectedItem & ";"
''            Next
''        Else
''            MsgBox "Er is op <Cancel> gedrukt..."
''        End If
    End With
    
    If strFileName = "" Then
        MsgBox "No file was selected.", vbOK, "No Selection"
        Exit Function
    End If
    strTable = "tablename"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    strTable, strFileName, blnHasFieldNames

End Function

Hij heeft 2 varianten, waarvan de tweede voor jou nu niet interessant is (meerdere bestanden inlezen). Maar wellicht heb je daar nog wat aan in de toekomst.
Ik heb 'm zelf een stuk flexibeler staan in een functie, zodat je verschillende parameters mee kunt geven. Maar dit zou voor jou moeten werken.

Ik zie dat je de CODE knop nog niet gevonden hebt

 

[kloer]

Heeee Octafish,
Geweldig. het werkt prima.

Bedankt voor je inzet.
Groet Klaas