title image


Smiley Tabellen importieren - Ein Beispiel
Hallo Libertos!Anbei ein Beispiel! Schöner Nebeneffekt, die Tabellen werden automatisch in eine Tabelle geschrieben bzw. angefügt ;-), d.h. du musst Sie später nicht mehr manuell zusammenfassen.Public Sub HoleExcelTabellen() ' Eine Fehlerbehandlung kann nie schaden ;-) On Error GoTo HandleErr ' Das Beispiel verwendet zur Suche der Dateien das ' FileSearch-Objekt. Dazu benötigen du einen Verweis ' auf die MS Office 8.0 bzw. 9.0 Objektbibliothek ' VBA-Ansicht - Extras - Verweise - Microsoft Office X.X Objekt Library ' die Objektvariable Dim objFileSearch As FileSearch ' allgemeine Variablen Dim lngI As Long Dim strPfad As String Dim strMsg As String ' Sanduhr ein DoCmd.Hourglass True ' Objekt zuweisen Set objFileSearch = Application.FileSearch ' Zwei Konstanten ' Filter: z.B. alle Word-Dokumente cFILTER = "*.DOC" ' oder alle Dateien die mit DB*.xls anfangen Const cFILTER = "*.xls" ' Laufwerk: z.B. cLAUFWERK = "C:\" Const cLAUFWERK = "H:\Developer Help\Forum\Libertos" ' Suchkriterium festlegen With objFileSearch .FileType = msoFileTypeAllFiles .FileName = cFILTER .LookIn = cLAUFWERK ' Unterordner durchsuchen -> Nein .SearchSubFolders = False ' Wurde was gefunden Select Case .Execute(msoSortByFileName, msoSortOrderAscending) ' Wenn nein, Meldung Case Is = 0 ' Sanduhr aus DoCmd.Hourglass False ' Ausgabe Meldung MsgBox "Es wurden keine Dateien gefunden" ' Wenn ja, durchlaufe die Schleife Case Is >= 1 ' über alle Dateien die gefunden wurden For lngI = 1 To .FoundFiles.Count ' Name und Pfad der Datei ermitteln strPfad = .FoundFiles(lngI) ' Bereich aus der Tabelle importieren DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel8, "tblExcelImport", strPfad, True, "DB-Sheet!A1:C21" ' Name und Pfad der Datei für die Ausgabe merken strMsg = strMsg & strPfad & vbCrLf ' Datei löschen -> kannst du ja erstmal auskommentiert lassen ;-) 'Kill strPfad Next lngI End Select ' Sanduhr aus DoCmd.Hourglass False ' Ausgabe der Meldung MsgBox "Folgende " & .FoundFiles.Count & " Dateien wurden in die " & _ "Tabelle tblExcelImport übertragen " & vbCrLf & vbCrLf & strMsg, _ vbInformation, "Hinweis" End WithExitHere: ' Speicher freigeben If Not objFileSearch Is Nothing Then Set objFileSearch = Nothing Exit SubHandleErr: Select Case Err.Number Case Else MsgBox "Fehler " & Err.Number & ": " & Err.Description, vbCritical, "Form_frmTabelleFüllen.cmdTabelleFuellen_Click" End Select Resume ExitHereEnd SubWenn du was nicht verstehst, melde dich!LLAPManuelaDa könnte man auch was finden ;-)Karl Donaubauers Access-FAQ: http://www.donkarl.comDev Ashish FAQ (The Access Web): http://www.mvps.org/access/KnowHow von Klaus Oberdalhoff: http://www.accessware.de/accessware/index.htmlWie kann man im Forum ... (formatieren):http://www.spotlight.de/ewf-faq/forumslink.htmMSDN-Online: http://msdn.microsoft.com/default.aspAccess Archive: http://www.accessarchive.com/Microsoft Acces Knowledge-Base: http://www.microsoft.com/intlkb/germany/support/kb/B_WACCESS.HTMMicrosoft Online-Suche: http://support.microsoft.com/support/search/Microsoft dt. Online-KB: http://search.microsoft.com/germany/supportkb/Beiträge von verschiedenen Access-NGs: http://home.t-online.de/home/Heinrich.Schramm/deja.htmlWinSite Archive - Microsoft Access Files (Demos & Freeware): http://www.winsite.com/win95/access/index.html
VBA & Acces Tipps & Tricks - Tutorials - Downloads uvm.
Mathematische Definition des allgemeinen Dringlichkeitsaxioms:
D = (PZ/K) * (C + A + N) - Fazit: Alle Dinge werden unter Druck schlimmer


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: