Macro om te importeren / Access 2007

Status
Niet open voor verdere reacties.
Dat kan uiteraard, als je met Multiselect werkt in het zoekvenster en het resultaat in een lus uitleest.
 
Je krijgt dan zoiets:

Code:
Function BestandOpzoeken(Optional Pad As String) As String
Dim dlgPicker As FileDialog
Dim sType() As String, sFile As String
Dim tmp As String, sPad As String
Dim bCheck As Boolean
Dim varItem As Variant

    On Error GoTo Hell
    If Pad = "" Then sPad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") Else: sPad = Pad
    If Right(sPad, 1) <> "\" Then sPad = sPad & "\"
    Set dlgPicker = Application.FileDialog(msoFileDialogFilePicker)
    With dlgPicker
        .Title = "Selecteer een bestand." 'De titel voor het venster
        .InitialFileName = sPad
        With .Filters
            .Clear
            .Add "Microsoft Excel", "*.xls; *.xlsx; *.xlsm", 1      'Beperk de bestandstypes tot .xls
            End With
        .FilterIndex = 1
        .AllowMultiSelect = True                   'Slechts één bestand kiezen toegestaan
        .InitialView = msoFileDialogViewList        'Bepaal weergave
        If .Show = -1 Then                          'Bepaal of gebruiker op OK-knop heeft geklikt.
            For Each varItem In .SelectedItems
                If Not sFile = vbNullString Then sFile = sFile & "|"
                sFile = sFile & varItem               'String wordt gevuld met geselecteerde bestand
            Next varItem
        Else
            MsgBox "Er is op <Annuleren> gedrukt..."
            BestandOpzoeken = "Annuleren"
            GoTo Hell
        End If
    End With
    BestandOpzoeken = sFile
    
Hell:
    Set dlgPicker = Nothing

End Function

De aanvullingen in de functie zijn nodig om de bestandenlijst op te bouwen. Elk geselecteerd bestand wordt gescheiden door een pipe teken. De totale string wordt bij de knop weer uit elkaar getrokken in een matrix variabele

Code:
Private Sub Command152_Click()
Dim sFiles As Variant
Dim i As Integer
    sFiles = Split(BestandOpzoeken("K:\Group\accounts\bp shell\bp\bp import map\") , "|")
    If LBound(sFiles) = UBound(sFiles) Then Exit Sub
    For i = LBound(sFiles) To UBound(sFiles)
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Brandstofrapport BP", sFiles(i), True
    Next i
End Sub

De code onder de knop trekt de bestandenstring weer uit elkaar en importeert elk bestand apart in de tabel. Is er niks gekozen (op Annuleren gedrukt) dan stopt de procedure.
Kijk maar eens of je het aan de praat krijgt.
 
Goedemiddag Octafish,

Bijna alles is gelukt.
Ik heb de knoppen grotendeels samengevoegd, het importeren gaat zoals gewenst... maar er is 1 klein detail wat nog niet goed gaat.

De query die de records omvormt tot een boekingsstuk laat geen regels zien die volledig gelijk zijn aan een andere regel.
Dit ligt waarschijnlijk aan de GROUP BY die ik heb ingevuld bij TOTALS, maar ik weet niet hoe ik het moet invullen dat echt elke regel 1 op 1 wordt overgenomen voor het boekingsstuk.
De regels die eruit gegooid worden zijn volledig identiek, behalve de tijd.

zou je me hier nog mee willen helpen, want ik krijg het ondanks verwoede pogingen nog altijd niet goed :(
 
.......... stom he.
Je post het bericht, leest het terug en leest het antwoord in je eigen vraag.
TEST
Check... het werkt.
Opgelost. :p
 
Je hebt gelijk, ik wist even niet waar dit te vinden.
Nu gedaan.

En nog hartelijk dank voor de hulp :thumb:
 
Goedemorgen Octafish,

Ik heb deze toch weer even op open gezet, omdat ik een eerder probleem met dit onderwerp niet terug kan vinden.
In een eerdere post meldde je aan mij dat wanneer ik deze code wilde gebruiken voor het importeren van 1 bestand de code moest worden aangepast van multiselect true naar false..... maar ook dat het onderstaande stukje code moest worden aangepast

onderstaande code werkt met multiselect, daarmee was vorige keer mijn probleem opgelost, maar ik weet niet hoe ik onderstaande stukje moet aanpassen voor het selecteren van slechts 1 bestand.
Zou je mij hiermee willen helpen? (dit is een vrijwel gelijke database als de shell/bp versie, maar hier is het altijd maar 1 bestand te importeren)

Private Sub Command0_Click()
Dim sFiles As Variant
Dim i As Integer
sFiles = Split(BestandOpzoeken("K:\Group\ACCOUNTS\ICS Mastercard"), "|")
If LBound(sFiles) = UBound(sFiles) Then Exit Sub
For i = LBound(sFiles) To UBound(sFiles)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Importtabel", sFiles(i), True
Next i
End Sub
 
De aanpassing is eigenlijk alleen nodig als je van Single naar Multi gaat, want dan verandert de werkwijze. Zet je een multi-lijst terug naar Enkel, dan kun je gewoon dezelfde code blijven gebruiken. Alleen is dan de loop niet effectief, omdat er maar één waarde is en de lus dus ook maar één keer wordt uitgevoerd.
Wil je het toch aanpassen, dan krijg je zoiets:
Code:
Private Sub Command0_Click()
Dim sFiles As Variant
Dim i As Integer
     sFiles = BestandOpzoeken("K:\Group\ACCOUNTS\ICS Mastercard")
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Importtabel", sFiles, True
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan