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, 603 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

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

Frage von Akrosh zum Thema PHP ...

Installation
gelöst Mit Powershell in einer Datei eine Zeile auslesen (6)

Frage von Bommi1961 zum Thema Installation ...

Batch & Shell
gelöst Einzelne Zeilen in txt Datei speichern und auslesen (7)

Frage von noah1400 zum Thema Batch & Shell ...

HTML
gelöst Mit HTML Datei eine Textdatei auslesen (7)

Frage von Maffi zum Thema HTML ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...

Windows Tools
gelöst Aussendienst Datensynchronisierung (12)

Frage von lighningcrow zum Thema Windows Tools ...

Windows Server
RODC über VPN - Verbindung weg (10)

Frage von stefan2k1 zum Thema Windows Server ...