Automatisere import af data fra stort antal excel-ark?

Jep - I access opretter du en tabel, som kan rumme dine fildata og en tabel som kan
rumme dine excel data.

Et eks. på hvordan man høvler 1000 arkreferencer ind i en tabel:
Sub test2()
Dim strfilepath As String
    strfilepath = xReturnFilePath("*.xls", "X:\testsager\YYY", True, "")
    MsgBox strfilepath
End Sub
---
Function xReturnFilePath(strFilename As String, _
    strDrive As String, _
    blnSearchSubDir As Boolean, _
    strFindThisText As String) As String
   
   
  Dim db As Database: Set db = CurrentDb()
  Dim FilnavnRS As Recordset, MyPos As Integer
 
  Dim varFile As Variant, strFileList As String, SearchChar As String, SearchString As String
  'åben tabellen til at modtage filnavne:
  '
    Set FilnavnRS = db.OpenRecordset("tblfilnavn", DB_OPEN_TABLE)
    strFileList = "Data er tilført tabellen tblfilnavn"
    SearchChar = "kal"
   
With Application.FileSearch
  .NewSearch
  .FileName = strFilename
  .LookIn = strDrive
  .SearchSubFolders = blnSearchSubDir
  '.TextOrProperty = "San*" 'find tekst i doc
  '.PropertyTests.Add "Contents", msoConditionIncludes, strFindThisText
  If .Execute(msoSortByFileName, msoSortOrderAscending, True) > 0 Then
      For Each varFile In .FoundFiles
        SearchString = CStr(varFile)
        MyPos = InStr(1, SearchString, SearchChar, 1)
        If MyPos > 0 Then
            ' Create a new record
            FilnavnRS.AddNew
           
            FilnavnRS(0) = varFile
            'FilnavnRS(1) = varFile.Path
            'FilnavnRS(2) = varFile.Name
            'FilnavnRS(3) = varFile.DateLastModified
            ' Save the new record
            FilnavnRS.Update
            'cboFoundCombo.AddItem varFile
        End If
      Next varFile
  Else
      'cboFoundCombo.AddItem "No Matching Files Located!"
      strFileList = "Vi fandt ikke noget der passede!"
  End If
  'cboFoundCombo.ListIndex = 0
     
End With
    FilnavnRS.Close
xReturnFilePath = strFileList
End Function
---

et ex. på hvordan du henter data fra excell regnearket:

Private Sub Hentdata_Click()
Dim A As String, filnavn As String
Dim xApp As Object
    filnavn = "X:\bytx\YYY.xls"
   
  Set xApp = CreateObject("Excel.Application")
    xApp.Workbooks.Open FileName:=filnavn
    xApp.Sheets("TESTARKNAVNETHER").Select
    'xApp.Visible = True
    xApp.Visible = False
    xApp.AskToUpdateLinks = True
    Me.filnavn = filnavn
    Me.BASISKODE = xApp.range("C8").Value
    Me.C1 = xApp.range("L44").Value
    Me.C2 = xApp.range("L56").Value
    Me.C3 = xApp.range("L69").Value
    Me.C4 = xApp.range("L75").Value
    Me.C5 = xApp.range("L103").Value
    Me.C6 = xApp.range("L132").Value
    Me.Totalpoints = xApp.range("H24").Value
    Me.Rate_Bygning = xApp.range("h32").Value
    Me.Rate_Driftstab = xApp.range("H30").Value
    Me.Rate_løsøre = xApp.range("H27").Value
    Me.RSnr = Nz(xApp.range("M4").Value, "Ubekendt RSnr")
    Me.RISKnavn = Nz(xApp.range("A2").Value, "Ubekendt Navn")
    Me.RISKAdr = Nz(xApp.range("A3").Value, "Ubekendt Adr")
    Me.Tarifdato = Nz(xApp.range("L2").Value, "Ubekendt Dato")
    Me.tarifVersion = Nz(xApp.range("F1").Value, "Ubekendt Tarifversion")
    xApp.ActiveWorkbook.Close savechanges:=False
End Sub
--
Der mangler blot at lave en rutine, der med et loop henter arkreferencen i filtabellen og levererer til dataudtræksrutinen, som selvfølgelig kan gemme filnavnen i din datatabel.

Håber det giver lidt inspiration.

Henrik

Jeg har ikke rodet med koden i et stykke tid. Dengang havde jeg et problem med at få den til at tie, hvis der er macroer bagved og om den skulle opdatere eksterne referencer. Det hele skulle gerne køre af sig selv. Det lykekdes mig at hente data fra 1300 ark over et net indenfor 2-3 kvarters tid.

Henrik

Tak for inspiration....det ser jo ud til at være noget af det rigtige. Men det funker ikke helt...for mig

ved første "Dim db As Database:" siger den " Compile error: User-defined type not defined".....og nu er jeg jo ikke lige ekspert...mangler der en "Type...End Type" for Database?

Ups du skal sikkert sætte en reference til Office objectet
'skal minimum bruge office 7 object modulet

Application.FileSearch ligger i Office objectet

?

Sikkert ok svar - mine kundskaber rakte ikke helt til at omsætte det...i mellemtiden er en anden løsning kommet i sigte.

Tak for indsatsen.

Mvh Anders

Det var synd, Anders. Du skulle bare sætte et tick i references for Office dll filen. Løbe rækken af referencer igennem og finde en af versionerne office 7-10. referencen hedder 'Microsoft Office 10 object library' og ligger i shared mappen under MSO.dll