hulp met querry excel naar excel

[Interface]

Voor mijn werk wil ik verticaal zoeken in een matrix in een ander bestand. Nu wil ik de gegevens importeren, maar ik wil deze niet in een werkblad hebben maar in een array die ik aan kan spreken.

Nu heb ik de onderstaande code opgenomen en een klein beetje aangepast. Dus mijn vraag is: Hoe krijg ik het onderstaande niet in een werkblad maar in een array?

Sub HaalOp()

Dim varArray As Variant
Dim strPad As String


strPad = "C:\Documents and Settings\Bureaublad""Actieve leverancier met ORRF 4 tbv NAF_onbeveilig.xls"

    With ActiveSheet.QueryTables.Add(Connection:=Array("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=left(strpad,(len(strpad)-1)) & right(strpad,(len(strpad)-1));Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";" _
        , _
        "Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:G" _
        , _
        "lobal Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Databas" _
        , _
        "e=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=F" _
        , "alse;Jet OLEDB:SFP=False"), Destination:=Range("A1"))
        
        .CommandType = xlCmdTable
        .CommandText = Array("LEV$")
        .Name = "Actieve leverancier met ORRF 4 tbv NAF_onbeveilig"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = strPad
        .Refresh BackgroundQuery:=False
    End With
    
    Sheets("blad3").Range("a1").Value = Array("Lev$")
    
End Sub

 

[snb]

Als je het niet in een werkblad wil moet je de database rechtstreeks openen en de gegevens daar uitlezen (bijv. met getobject("C:\bestand.mdb").

De plaatsing van gegevens in een werkblad is inherent aan het gebruik van een databasequery.
Daarna kun je de gegevens in een array zetten en de gegevens uit het werkblad verwijderen met:

sq=range("A1").currentregion
range("A1").currentregion.clearcontents

Alls gegevens zitten nu in de matrixvariabele sq.

 

[Interface]

Duidelijk

Maar heb je misschien een voorbeeld van GetObject....?

Op zich ben ik wel handig met VBa, maar het werken met SQL en gegevens importeren vanuit een ander bestand daar heb ik nooit echt kaas van gegeten....

 

[snb]

Voorbeeld:

Sub tst()
  With GetObject("E:\Access\fiets.mdb")
     .Application.DoCmd.RunSQL "SELECT * INTO Q_test From Tabel1"
        
     With .Application.CurrentDb.TableDefs("Q_test").OpenRecordset
       .MoveFirst
       Do
         sq = Split(!lidnummer & "|" & !naam & "|" & !adres & "|" & !postcode & "|" & !plaats, "|")
         .movenext
       Loop Until .EOF
     End With
     .Quit
   End With
End Sub

De Access-database 'fiets' wordt geopend.
Met een SQL-opdracht wordt een nieuwe tabel 'Q_test' gemaakt.
Vervolgens worden per record in die tabel de veldgegevens (velden 'lidnummer', 'naam', 'adres', 'psotcode', 'plaats') in de array sq gezet.
Vervolgens wordt het bestand gesloten.
Hiermee kun je eenvoudig gegevens van een Access-tabel uitlezen vanuit Excel of een andere Office-applicatie.

 

[Interface]

Handig SQL

Heb je macro geprobeerd en ik kom er aardig uit.

Heb nu de onderstaande code om een tabel op te halen en deze te plaatsen in aantal array's gelijk aan het aantal kolommen in de database..

In het verleden heb ik nooit echt gebruik gemaakt van database en sql, maar ik zie hierdoor nu veel meer mogelijkheden.

Ik heb nu de onderstaande code

Option Explicit

'                   ********************    ********************
'               ********************            ********************
'           ********************                    ********************
'   ********************              Interface             ********************
'           ********************                    ********************
'               ********************            ********************
'                   ********************    ********************

Sub Proberen()

Dim Kolom1(), Kolom2(), Kolom3(), Kolom4(), strNaamDataBase, strNaamTijdelijk, strSQL As String
Dim lngTeller As Long

strNaamTijdelijk = "TijdelijkTabel"
strNaamDataBase = "DBhaalop"

lngTeller = 0

strSQL = "SELECT * INTO " & strNaamTijdelijk & " From " & strNaamDataBase

  With GetObject("c:\ophaal.mdb")
  
     .Application.DoCmd.RunSQL strSQL
        
     With .Application.CurrentDb.TableDefs(strNaamTijdelijk).OpenRecordset
       .MoveFirst
       
       Do
       
       ReDim Preserve Kolom1(lngTeller), Kolom2(lngTeller), Kolom3(lngTeller), Kolom4(lngTeller)
       
        Kolom1(lngTeller) = !Week
        Kolom2(lngTeller) = !Naam
        Kolom3(lngTeller) = !Woonplaats
        Kolom4(lngTeller) = !Auto
         
         lngTeller = lngTeller + 1
         
         .movenext
       Loop Until .EOF
     End With
     
     .Quit
   End With
   
    For lngTeller = 0 To UBound(Kolom1)

        Sheets(1).Range("a" & lngTeller + 1).Value = Kolom1(lngTeller)
        Sheets(1).Range("b" & lngTeller + 1).Value = Kolom2(lngTeller)
        Sheets(1).Range("c" & lngTeller + 1).Value = Kolom3(lngTeller)
        Sheets(1).Range("d" & lngTeller + 1).Value = Kolom4(lngTeller)

    Next
   
End Sub

En de volgende sub om de tijdelijke kolom tabel te verwijderen

Sub VerwijderNutteLozeTabel()

Dim strNaamTijdelijk As String

strNaamTijdelijk = "TijdelijkTabel"

    With GetObject("c:\ophaal.mdb")

        .Application.DoCmd.RunSQL "Drop Table " & strNaamTijdelijk
    
    .Quit
    
    End With

End Sub

 

[snb]

Dat kan simpeler:

Sub Proberen()

strNaamTijdelijk = "TijdelijkTabel"
strNaamDataBase = "DBhaalop"

With GetObject("c:\ophaal.mdb").Application
  .DoCmd.RunSQL "SELECT * INTO " & strNaamTijdelijk & " From " & strNaamDataBase
  With .CurrentDb.TableDefs(strNaamTijdelijk).OpenRecordset
     .MoveFirst
       
     Do
       Sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(,4)=       Split(!Week & "|" & !Naam & "|" & !Woonplaats & "|" & !Auto, "|")
       .movenext
      Loop Until .EOF
   End With
     
   .Quit
   End With
End Sub