Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Datei Name und Pfad auslesen mit FSO Objekt

Frage Entwicklung VB for Applications

Mitglied: Gimli3311

Gimli3311 (Level 1) - Jetzt verbinden

24.02.2015, aktualisiert 13:37 Uhr, 636 Aufrufe, 3 Kommentare

Hallo Zusammen,

ich möchte gerne den Dateinamen und den Pfad von der Datei jeweils in zwei Variablen speichern.
Ich weis das ich über das FSO Objekt entsprechende Methoden habe wie .Name oder .Path um diese Infos auszulesen
Habe versucht über objFoundFiles darauf zuzugreifen aber es ist nicht möglich. Denke es hängt daran das objFoundFile eine Collection ist, wenn ich diese aber zu einem Objekt ändere bekomm ich weitere Fehlermeldungen. Hab ich doch das falsche Objekt genommen um die Infos auszulesen?

Gruß Gimli3311


Hier der Code:
01.
Option Compare Text 'benötigt für einen 'like' Vergleich 
02.
 
03.
Dim fso As Object 'Variable ganz am Anfang des Codefensters stehen lassen ! 
04.
Dim wb As Worksheet 
05.
 
06.
 
07.
Sub ImportTables() 
08.
 
09.
    'Variabeln werden mit passenden Datentypen gesetzt 
10.
     Dim rngOut As Range, f As Variant, objFoundFiles As New Collection, strFileFilter As String 
11.
     
12.
    With ActiveSheet 
13.
        'erste Ausgabezelle in neuer .xlsx-Datei festlegen 
14.
        Set rngOut = .Range("A2") 
15.
         
16.
        'Sheet ab Range-Paste vor Import gegebenenfalls bereinigen 
17.
        If .UsedRange.Rows.Count >= rngOut.Row Then 
18.
            .Rows(rngOut.Row & ":" & .UsedRange.Rows.Count).Clear 
19.
        End If 
20.
    End With 
21.
     
22.
    'FilesystemObject erstellen 
23.
     Set fso = CreateObject("Scripting.Filesystemobject") 
24.
 
25.
    'Pfad in dem die *.xlsx Dateien liegen wird mit der Funktion fncBrowseForFolder ausgewählt 
26.
    'andere Möglichkeit direkter Pfad angeben= (PATHFILES muss dann CONST gesetzt werden) "I:\Projects-Global\ITIS\IT37639_Logbuch_Zusammenfuehrung\090_Infos_Intern\Gleiche_Logbuecher_Test" 
27.
 
28.
    'Greif auf die Funktion fncBrowseForFolder zu um einen Ordner auszuwählen 
29.
    PATHFILES = fncBrowseForFolder 
30.
    'Inputbox wird erstellt in der das Suchwort eingegeben werden soll 
31.
    strFileFilter = InputBox("Dateinamensteileingeben :" & Chr(13) & "z.B. Eingabe_* (ohne Datei-Erweiterung, es werden nur *.xlsx, *.xlsm und *.xls Dateien gesucht)") 
32.
 
33.
 
34.
    'Suche Dateien mit passenden Namen 
35.
 
36.
    enumFiles fso.GetFolder(PATHFILES), strFileFilter, objFoundFiles 
37.
 
38.
    'Wenn Dateien gefunden wurden 
39.
    If objFoundFiles.Count > 0 Then 
40.
        'Führt das Makro schneller aus und unterdrückt Meldungen 
41.
        Application.ScreenUpdating = False 
42.
        Application.DisplayAlerts = False 
43.
 
44.
        With ActiveSheet 
45.
            'Für jede gefundene Datei in der Collection 
46.
            For Each f In objFoundFiles 
47.
                'öffne Datei 
48.
                Set wb = Workbooks.Open(f, ReadOnly:=True).Sheets(1) 
49.
                 'Vergleiche Vorlage mit geöffneter Datei 
50.
                 If .Range("A1").Value & .Range("B1").Value & .Range("C1").Value & .Range("D1").Value & .Range("E1").Value & .Range("F1").Value & .Range("G1").Value & .Range("H1").Value & .Range("I1").Value & .Range("J1").Value & .Range("K1").Value & .Range("L1").Value & .Range("M1").Value & .Range("N1").Value Like wb.Range("A28").Value & wb.Range("B28").Value & wb.Range("C28").Value & wb.Range("D28").Value & wb.Range("E28").Value & wb.Range("F28").Value & wb.Range("G28").Value & wb.Range("H28").Value & wb.Range("I28").Value & wb.Range("J28").Value & wb.Range("K28").Value & wb.Range("L28").Value & wb.Range("M28").Value & wb.Range("N28").Value Then 
51.
                    'Kopiere A29:N Variable 
52.
                    wb.Range("A29:N" & wb.Cells(Rows.Count, 1).End(xlUp).Row).Copy rngOut 
53.
                End If 
54.
                'schließe Dokument wieder 
55.
                wb.Parent.Close False 
56.
                'Ausgabezelle für den nächsten Import ermitteln 
57.
                Set rngOut = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
58.
            Next 
59.
            '----Funktionsaufruf um Leere Spalten zu löschen 
60.
           deleteEmptyCells 
61.
             
62.
        End With 
63.
        Application.ScreenUpdating = True 
64.
        Application.DisplayAlerts = True 
65.
 
66.
    End If 
67.
 
68.
End Sub 
69.
 
70.
' Öffnet das Suchfeld für die Ordnerauswahl 
71.
 
72.
 
73.
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String 
74.
 
75.
  Dim objFlderItem As Object, objShell As Object, objFlder As Object 
76.
 
77.
 
78.
  Set objShell = CreateObject("Shell.Application") 'Vordefinierter Pfad einstellen zu Testzwecken (Standard--> DefaultPath) 
79.
  Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, "I:\Projects-Global\ITIS\IT37639_Logbuch_Zusammenfuehrung") 
80.
 
81.
  If objFlder Is Nothing Then GoTo ErrExit 
82.
 
83.
  Set objFlderItem = objFlder.Self 
84.
  fncBrowseForFolder = objFlderItem.Path 
85.
 
86.
ErrExit: 
87.
  Set objShell = Nothing 
88.
  Set objFlder = Nothing 
89.
  Set objFlderItem = Nothing 
90.
 
91.
End Function 
92.
 
93.
 
94.
Function deleteEmptyCells() 
95.
 
96.
 Dim lngLetzte As Long 
97.
 Dim lngZeile As Long 
98.
  
99.
 ' Bildschirmaktualisierung AUSschalten (Makro läuft schneller, Bildschirm flackert nicht) 
100.
 Application.ScreenUpdating = False 
101.
 ' Letzte belegte Zelle in Spalte B plus 1 raussuchen und merken 
102.
 lngLetzte = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 2, 65536) 
103.
 ' in einer Schleife von dieser Letzten bis Zeile 1 gehen - also von unten nach oben 
104.
      For lngZeile = lngLetzte To 1 Step -1 
105.
    ' Wenn die Zelle in der ensprechenden Zeile in Spalte B leer ist 
106.
        If Cells(lngZeile, 2) = "" Then 
107.
    ' dann lösche die gesamte Zeile 
108.
          Cells(lngZeile, 2).EntireRow.Delete 
109.
    ' Ende der Bedingung 
110.
        End If 
111.
    ' Nächste Zeile mit der Bedingung vergleichen 
112.
      Next 
113.
 ' Bildschirmaktualisierung EINschalten (nicht vergessen) 
114.
 Application.ScreenUpdating = True 
115.
 
116.
 
117.
End Function 
118.
 
119.
'Funktion um Dateien rekursiv zu suchen 
120.
 
121.
 
122.
Sub enumFiles(ByVal RootFolder As Object, ByVal strFilter As String, ByRef col As Collection) 
123.
 
124.
    On Error Resume Next 
125.
    For Each file In RootFolder.Files 
126.
        ext = LCase(fso.GetExtensionName(file.Name)) 
127.
        If fso.GetBasename(file.Name) Like strFilter And (ext = "xlsx" Or ext = "xls") Then 
128.
            col.Add file.Path 
129.
        End If 
130.
    Next 
131.
    For Each subfolder In RootFolder.SubFolders 
132.
        enumFiles subfolder, strFilter, col 
133.
    Next 
134.
 
135.
End Sub 
136.
 
Mitglied: colinardo
LÖSUNG 24.02.2015, aktualisiert um 13:38 Uhr
Hallo Gimli3311,
auf deinen Codekontext bezogen, machst du das so
01.
'Pfad der Datei 
02.
strPathName = fso.GetParentFolderName(f) 
03.
'Dateiname 
04.
strFilename = fso.GetFileName(f)
Grüße Uwe

-edit- Funktions-Fehlerkorrektur Zeile 2
Bitte warten ..
Mitglied: emeriks
24.02.2015, aktualisiert um 13:38 Uhr
Hi,
es wäre hilfreich, zu wissen, welchen Fehler (Wortlaut) Du wo (Zeilennummer) bekommst.

Aber ich denke, es liegt daran, dass f nicht Variant sondern String sein muss.

E.
Bitte warten ..
Mitglied: Gimli3311
24.02.2015 um 13:37 Uhr
Danke Uwe ;)

Gruß Sergej
Bitte warten ..
Ähnliche Inhalte
Batch & Shell
gelöst Datei aus Verzeichnis auslesen? (4)

Frage von freshman2017 zum Thema Batch & Shell ...

Batch & Shell
gelöst Ordner und Datei Name gleich (BATCH) (12)

Frage von clragon zum Thema Batch & Shell ...

PHP
gelöst Externe XML-Datei in PHP auslesen (18)

Frage von Akrosh zum Thema PHP ...

Outlook & Mail
gelöst Outlook 2016 Anhang vollständiger Name der Datei anzeigen (5)

Frage von mah0ni zum Thema Outlook & Mail ...

Neue Wissensbeiträge
Tipps & Tricks

Wie Hackt man sich am besten in ein Computernetzwerk ein

(38)

Erfahrungsbericht von Herbrich19 zum Thema Tipps & Tricks ...

Humor (lol)

Bester Vorschlag eines Supporttechnikers ever: APC

(15)

Erfahrungsbericht von DerWoWusste zum Thema Humor (lol) ...

Heiß diskutierte Inhalte
Festplatten, SSD, Raid
POS Hardware und alternativen zu Raid 1? (21)

Frage von Brotkasten zum Thema Festplatten, SSD, Raid ...

Viren und Trojaner
Verschlüsselungstrojaner simulieren (18)

Frage von AlbertMinrich zum Thema Viren und Trojaner ...

Server-Hardware
gelöst Empfehlung KVM over IP Switch (8)

Frage von Androxin zum Thema Server-Hardware ...

Ubuntu
Nextcloud 12 Antivirus App for Files (8)

Frage von horstvogel zum Thema Ubuntu ...