title image


Smiley Re: Laufwerk auslesen, Cover drucken ?
Das würde ich vielleicht so machen:



1.) CD-Laufwerk per FileSearch durchsuchen



2.) Gefundene Dateien in ein Textfile wegspeichern



3.) Textfile z.B. per "Datei / Externe Daten / Tabellen verknüpfen" einbinden; Trennzeichen = Backslash ("\")



Ich poste Dir mal zwei Functions, mit denen Du Auslesen und in eine Textdatei wegschreiben kannst. Sieht erst mal viel aus, im Grunde musst Du sie aber nur in ein allgemeines Modul kopieren und den Verweis auf die "MS Office Object Library" setzen, dann sollten die schon funktionieren (entwickelt in A2K, laufen bei mir prima).





Public Function SearchFiles(strPathName As String, _

Optional bolSearchSubFolders As Boolean = True, _

Optional strFileName As String, _

Optional lngFileType As MsoFileType = msoFileTypeAllFiles, _

Optional strSearchText As String, _

Optional bolMatchTextExactly As Boolean = False, _

Optional lngLastModified As MsoLastModified = msoLastModifiedAnyTime, _

Optional lngSortBy As MsoSortBy = msoSortByFileName, _

Optional lngSortOrder As MsoSortOrder = msoSortOrderAscending) As FoundFiles



' ========================================================================

' Funktion:

' =========

' Durchsucht ein Verzeichnis und gibt die gefundenen Dateien

' entsprechend der Parametrisierung zurück

'

' Eingabeparameter:

' =================

' strPathName (benötigt) : Name des zu durchsuchenden Verzeichnisses

' bolSearchSubFolders (optional): Unterverzeichnisse durchsuchen ja / nein

' strFileName (optional) : Zu suchende Dateinamen (mit * einschränkbar)

' lngFileType (optional) : Zu suchende Dateitypen

' strSearchText (optional) : Zu suchender Text in der Datei

' bolMatchTextExactly (optional): Nur Dateien suchen, bei denen strSearchText exakt

' enthalten ist (Groß- / Kleinschreibung beachten)

' lngLastModified (optional) : Letzte Modifizierung der Datei wann?

' lngSortBy (optional) : Gefundenen Dateien nach was sortieren?

' lngSortOrder (optional) : auf- / absteigend

'

' Rückgabewert:

' =============

' Gibt ein FoundFiles-Objekt zurück, wenn etwas gefunden wurde;

' Gibt 'Nothing' zurück, wenn nichts gefunden wurde

' oder ein Laufzeitfehler aufgetreten ist.

'

' Verweise:

' =========

' Verweis auf die Microsoft Office Object Library erforderlich!

' ========================================================================



Const cstrDummyPath As String = "C:\"

Const cstrDummyFiles As String = "*.jnk"



Dim fs As FileSearch

Dim i As Long



On Error GoTo SearchFilesErr



Set SearchFiles = Nothing

Set fs = Application.FileSearch

With fs



' Dummy-Aufruf von FileSearch wegen Bug beim Sortieren nach Datum LastModified:

' ("Aufwecken" von FileSearch ;-)

' ---Start---------------------------------------------------------------------

.NewSearch

.LookIn = cstrDummyPath

.FileName = cstrDummyFiles

.Execute SortBy:=msoSortBySize

' ---Ende----------------------------------------------------------------------



' Echter Aufruf von FileSearch:

.NewSearch

.LookIn = strPathName

.SearchSubFolders = bolSearchSubFolders

.FileName = strFileName

.FileType = lngFileType

.TextOrProperty = strSearchText

.MatchTextExactly = bolMatchTextExactly

.LastModified = lngLastModified



If .Execute(lngSortBy, lngSortOrder) > 0 Then

Set SearchFiles = .FoundFiles

End If



End With





SearchFilesExit:

Set fs = Nothing

Exit Function



SearchFilesErr:

Set SearchFiles = Nothing

Resume SearchFilesExit



End Function











Public Function TextFileAppend(strText As String, _

strFileName As String, _

Optional bolCreate As Boolean = False)



' =============================================================================

' Funktion:

' =========

' Hängt den übergebenen String einer Textdatei an

'

' Eingabeparameter:

' =================

' strText: Anzuhängender Text

' strFileName: Name der zu beschreibenden Datei

' =============================================================================



Const lngForAppending = 8



Dim fso As Object

Dim fsoOutFile As Object





On Error GoTo TextFileAppendErr



Set fso = CreateObject("Scripting.FileSystemObject")

Set fsoOutFile = fso.OpenTextFile(strFileName, lngForAppending, bolCreate)

fsoOutFile.WriteLine strText

fsoOutFile.Close





TextFileAppendExit:

Set fsoOutFile = Nothing

Set fso = Nothing

Exit Function



TextFileAppendErr:

MsgBox Err.Description, vbCritical, "TextFileAppend: Fehler " & Err.Number & " aufgetreten!"

Resume TextFileAppendExit



End Function







Aufgerufen wird der Vorgang dann wie folgt (hier: Laufwerk C:\ auslesen und in Datei C:\Temp\LaufwerkC.txt wegschreiben):





Sub AufrufSearchFiles()



Dim i As Long

Dim sf As FoundFiles



On Error GoTo AufrufSearchFilesErr



Set sf = SearchFiles("C:\", True)



If Not sf Is Nothing Then

On Error Resume Next

For i = 1 To sf.Count

'Debug.Print sf(i)

TextFileAppend sf(i), "C:\Temp\LaufwerkC.txt", True

DoEvents

Next i

On Error GoTo AufrufSearchFilesErr

End If



MsgBox "Fertig!"



AufrufSearchFilesExit:

Set sf = Nothing

Exit Sub

AufrufSearchFilesErr:

Resume AufrufSearchFilesExit



End Sub







Wie gesagt: Sieht erst mal viel aus, ist aber im Grunde nur Copy & Paste. Hoffe, Du bringst es zum Laufen!



Schönen Gruß,

Eric

Spotlight-Kicktipp gestartet!

Steig ein und trete mit Deinem Bundesliga-Tipp gegen die Besten an! :o)

http://www.kicktipp.de/spotlight/



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: