Import fra eet ark i flere excel-filer i een mappe.

Prøv at lege lidt med denne:

Private Sub Kommandoknap16_Click()
Dim VARa As String
VARa = InputBox(Prompt:="Indtast stien til Excel-arket.", Title:="Hvor ligger Excel-filen?", Default:="c:\journaler\DKDCPCxxx")
DoCmd.SetWarnings False
DoCmd.TransferSpreadsheet acImport, 0, "Importtest", VARa, False, ""
MsgBox "Importen er udført."
End Sub

Du importerer simpelthen den fil der er angivet i inoutboksen. Jeg har givet boksen en default værdi. Den er hentet fra en 2003 db, men så vidt jeg husker er den oprindelig lavet i Acc97.

Det bragte mig et godt stykke af vejen, men jeg kan ikke få den til at acceptere wildcards for arknavne (DKDCPCxxxx).
Jeg fik flækket nedenstående sammen, men det er hverken pænt eller hurtigt.
Jeg ville helst undgå, at skulle være nødt til at åbne hver eneste fil og løbe den igennem for at finde det rigtige ark.

Private Sub Kommandoknap16_Click()

'Fra http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpWktFilesSepTbls


Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String
Dim ws As Excel.worksheet
Dim appExcel As Excel.Application
Dim wb As Workbook



' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Documents and Settings\dkdcbk\Skrivebord\Journaler\"

' Replace worksheetname with the real name of the worksheet that is to be
' imported from each file
strWorksheet = "DKDCPC"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")

Set appExcel = CreateObject("Excel.Application")

Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      strTable = "tbl_" & strWorksheet
       
       
        Set wb = appExcel.Workbooks.Open(strPathFile)
        For Each sh In wb.Sheets
        If Left(sh.Name, 6) = strWorksheet Then
   
            DoCmd.TransferSpreadsheet acImport, _
                  acSpreadsheetTypeExcel9, strTable, strPathFile, _
                  blnHasFieldNames, sh.Name & "$", False

        End If
        Next
 
    strFile = Dir()
    wb.Close

     
Loop

    appExcel.Quit
       
End Sub