Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
368to372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
368to372
368to372
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateiinfo beliebige Datei lesen + ändern

Dateiinfo beliebige Datei lesen + ändern
24.01.2004 12:59:45
andre
hallo allerseits,
habe aus den faq folgendes beispiel, dass alle info's aller dateien eines verzeichnisses ausliest. ich bekomme es aber nicht hin, nur eine spezielle datei oder eine mehrfachauwahl anzusprechen, die ich mit application.getopenfilename auswähle.
Hier der originalcode:
http://xlfaq.herber.de/texte/volumina/209403x.htm

Sub ExtendedInfos()
Dim objShell As Object
Dim objFolder As Object
Dim iCounter As Integer, iRow As Integer, iCol As Integer
Dim strFileName As Variant
Dim arrHeaders(34)
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("D:\SP")
iRow = 3
iCol = 1
For iCounter = 0 To 33
arrHeaders(iCounter) = _
objFolder.getdetailsof(strFileName, iCounter)
Next iCounter
For Each strFileName In objFolder.items
For iCounter = 0 To 33
Cells(iRow + iCounter, 1).Value = iCounter + 1
Cells(iRow + iCounter, 2).Value = arrHeaders(iCounter)
Cells(iRow + iCounter, 3).Value = _
objFolder.getdetailsof(strFileName, iCounter)
Next iCounter
iRow = iRow + 35
Next strFileName
Application.ScreenUpdating = True
End Sub

darauf will ich zugreifen und nur davon die info's:
strFilename = Application.GetOpenFilename("GIF Files (*.gif), *.gif", , True)
strfilename wird ein array wegen der mehrfachauswahl. die schleife bekomme ich selber hin ;-) ....
hinterher will ich die info's einer datei gezielt ändern, z.b. die info nr. 30
danke und gruss andre

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateiinfo beliebige Datei lesen + ändern
25.01.2004 10:52:12
Coach
Hallo Andre,
hier der Code zur tabellarischen Anzeige der Dateiinfos ausgewählter Dateien:

Sub ExtendedInfos()
Dim objShell As Object
Dim objFolder As Object
Dim iCounter As Integer, iRow As Integer, iCol As Integer
Dim strFileName As Variant
Dim arrHeaders(34)
Dim FileName As Variant, iFil As Long, Verz$
On Error GoTo Fehler
FileName = Application.GetOpenFilename("GIF-Files (*.GIF), *.GIF", 1, "DateiInfo", "Infos", True)
If Not (IsArray(FileName)) Then Exit Sub
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Cells.ClearContents
Verz = CurDir()
If Right(Verz, 1) <> "\" Then Verz = Verz & "\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(UCase(Verz))
For iCounter = 0 To 33
arrHeaders(iCounter) = _
objFolder.getdetailsof(strFileName, iCounter)
Cells(1, iCounter + 1) = arrHeaders(iCounter)
Next iCounter
For iFil = LBound(FileName) To UBound(FileName)
FileName(iFil) = Mid(FileName(iFil), Len(Verz) + 1)
Next
iRow = 2
For Each strFileName In objFolder.items
For iFil = LBound(FileName) To UBound(FileName)
If (StrComp(strFileName.Name, FileName(iFil), vbTextCompare) = 0) Then
For iCounter = 0 To 33
Cells(iRow, iCounter + 1).Value = iCounter + 1
Cells(iRow, iCounter + 1).Value = arrHeaders(iCounter)
Cells(iRow, iCounter + 1).Value = objFolder.getdetailsof(strFileName, iCounter)
Next iCounter
iRow = iRow + 1
Exit For
End If
Next iFil
Next strFileName
GoTo Ende
Fehler:
MsgBox Err.Description
Ende:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Gruß Coach
Anzeige
AW: Dateiinfo beliebige Datei lesen + ändern
25.01.2004 15:20:41
andre
hallo coach,
danke schön, habe deine lösung getestet, und bringt das gewünschte ergebnis. ein kleiner fehler war drin:
beim dateinamenvergleich bringt strfilename.name den dateinamen ohne erweiterung, und filename(..) ist mit erweiterung. die muss ich da erst abziehen:
...
If (StrComp(strFileName.Name, Left(FileName(iFil), Len(FileName(iFil)) - 4), vbTextCompare) = 0) Then
...
wenn mal jemand andere dateien abfragt - der muss Len(FileName(iFil)) - 4 entsprechend anpassen - es gibt ja außer *.123 auch *.1234 z.b. .htm und .html oder *.jpg und *.jpeg ...
ich habe gerade auch eine interessante lösung herausgefunden, bei der ich die datei(en) direkt anspreche:

Sub ExtendedInfos2()
Dim objShell As Object
Dim objFolder As Object
Dim iCounter As Integer, iRow As Integer, iCol As Integer
Dim strFileName As Variant, strFileNameOpen As Variant
Dim arrHeaders(34), ordner
Application.ScreenUpdating = False
'variable ordner kann entfallen wenn bei objShell.Namespace(ordner) die formel eingesetzt wird
'strFileNameOpen = MID... dann unmittelbar nach objShell.Namespace(...) programmieren
strFileNameOpen = Application.GetOpenFilename("GIF Files (*.gif), *.gif", , False)
ordner = Left(strFileNameOpen, InStrRev(strFileNameOpen, "\"))
strFileNameOpen = Mid(strFileNameOpen, InStrRev(strFileNameOpen, "\") + 1)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(ordner)
Set strFileName = objFolder.parsename(strFileNameOpen)
iRow = 3
iCol = 1
For iCounter = 0 To 33
arrHeaders(iCounter) = _
objFolder.getdetailsof(objFolder, iCounter)
Next iCounter
For iCounter = 0 To 33
Cells(iRow + iCounter, 1).Value = iCounter + 1
Cells(iRow + iCounter, 2).Value = arrHeaders(iCounter)
Cells(iRow + iCounter, 3).Value = _
objFolder.getdetailsof(strFileName, iCounter)
Next iCounter
iRow = iRow + 35
Application.ScreenUpdating = True
End Sub

bei mir fehlt noch die mehrfachauswahl, dann will ich die ausgabe auch rumdrehen in die waagerechte, und dann eigenschaften schreiben ... und zum schluss schreib ich's noch passend für 97 um, da gibt's ja InStrRev usw. nicht und hoffentlich läuft der rest.
dann sehe ich, wenn ich im explorer mit der maus auf die datei gehe ein paar mehr info's als nur den dateinamen, so nach der devise urlaub auf rhodos - meine frau und ich, ich und meine frau, wir beide in der sonne ... ;-)) - scherz beiseite, es wird schon was ernsthaftes.
gruss andre
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige