|
| |
Visual-Basic Einsteiger| Re: Zugriff von Excel 2016 auf MPEG Datei Header | |  | | Autor: Tscharlie | | Datum: 30.06.20 16:24 |
| Hallo Zusammen,
damit es man es sich besser vorstellen kann, habe ich das (vorläufig) komplette Makro mal reingestellt.
es geht um den Block Z.39 - Z.52
Stelle ich den Pfad-Namen direkt in Set ObjFolder rein, dann funktioniert es, kopiere ich ihn per String Variable rein, springt das Makro ohne Err-Code zum Ende
1 Private Sub GetDet()
2 '********************************
3 Dim objShell As Object 'Shell
4 Dim objFolder As Object 'Folder
5 Dim objFolderItem As Object 'Datei
6 Dim I As Long
7 Dim szItem As String
8 '*******************************
9 Dim FSO As Object
10 Dim InsSte As Integer
11 Dim Zae1 As Long, GesZae As Long, Zae2 As Long, FindZei As Long 'Zähler für Schleife
12 Dim HL1 As String, ZellAdr As String, KeyStr As String, DoppStr As String, TMP As String
13 Dim FilKZ As Integer, ZeiNr As Long, intZeile As Integer, IZ As Integer
14 Dim NAECHSTER As String, Pfad As String, Datei As String, Zeich As String
15 '*******************************
16 Set FSO = CreateObject("scripting.filesystemobject")
17 Set objShell = CreateObject("Shell.Application")
18 '*******************************
19 Application.Calculation = xlManual
20 Application.ScreenUpdating = False
21 '*******************************
22 Zae1 = 2
23 IZ = 2
24
25 WEITER:
26 GesZae = Range("D65535").End(xlUp).Row
27 Do While Zae1 <= GesZae
28 If Cells(Zae1, 4) = "" Or Left(Cells(Zae1, 4), 1) = "'" Then GoTo NAECHSTER
29 HL1 = UCase(Cells(Zae1, 4).Hyperlinks(1).Address)
30 If HL1 <> "" And (Cells(Zae1, 14) = 0 Or Cells(Zae1, 14) = "") Then
31 InsSte = UCase(InStr(HL1, "MOVIE")) + 5
32 HL1 = "Z:" & Trim(Mid(HL1, InsSte, 250))
33
34 If FSO.FileExists(HL1) Then
35 With FSO.GetFile(HL1)
36 Cells(Zae1, 14) = .Size / 1000
37 Cells(Zae1, 15) = .DateLastModified
38 End With
39 '*** Anfang: um diesen Block geht es:
40 Pfad = Left(HL1, InStrRev(HL1, "\"))
41 ' lt. Debug.Print = Pfad: "Z:\MÄRCHEN, SAGEN, LEGENDEN\NIBELUNGEN\"
42
43 '***wenn ich das setze, funktioniert es nicht:
44 'Set objFolder = objShell.Namespace(Pfad)
45
46 'Direkteingabe funktioniert, kann ich aber nicht brauchen
47 Set objFolder = objShell.Namespace("Z:\MÄRCHEN, SAGEN, LEGENDEN\NIBELUNGEN\")
48 Datei = Mid(HL1, InStrRev(HL1, "\") + 1)
49 Set objFolderItem = objFolder.parsename(Datei)
50 'Video-Auflösung:
51 Cells(Zae1, 26) = objFolder.GetDetailsOf(objFolderItem, 316) & "x" & Folder.GetDetailsOf(objFolderItem, 314)
52 '***** Blockende
53 Else
54 Stop
55 Debug.Print Zae1 & " "; Cells(Zae1, 4) & " " & HL1 & " HL Link ist nicht i.O." 'falscher HL
56 GoTo NAECHSTER
57 End If
58 End If
59 NAECHSTER:
60 Zae1 = Zae1 + 1
61 HL1 = ""
62 'If Zae1 = 13553 Then Stop
63 'Debug.Print Zae1 '**********************
64 Loop
65
66 Set objFolder = Nothing
67 Set objShell = Nothing
68 Application.Calculation = xlCalculationAutomatic
69 Application.ScreenUpdating = True
70 MsgBox "Fertig!!!"
71 End Sub | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
sevISDN 1.0 
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats Neu! sevCoolbar 3.0 
Professionelle Toolbars im modernen Design!
Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Weitere Infos
|
| |
|
Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|
Mai 2024
Sie sind aktuell nicht angemeldet.
