Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1440to1444
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
Inhaltsverzeichnis

bestimmte datei auch im unterordner suchen

bestimmte datei auch im unterordner suchen
12.08.2015 07:41:41
makedonec
hallo
vor 2j hat mit Aloys78 ein vba code gebastelt was wunderbar funktioniert.
ich möchte das makro etwas erweitern, weiss aber nicht wie :/
hoffe ich kann mit mein schlechtes deutsch gut erklären und jemand hilft mir.
ALSO im Moment ist es so:
bevor die vorlage gespeichert wird, wird nur der aktuele ordner (August ist 08) durchsucht ob die Datei vielleicht schon vorhanden ist. wenn ja wird sie geöffnet, wenn nicht, wird sie automatisch erstellt und gespeichert.
oft befindet sich die datei in ein früheren ordner (z.B 06) der vor 2 monate erstellt wurde. manchmal sogar 1 jahr davor
ich möchte also dass zuerst ALLE ordner und unterordner nach der Datei durchsucht werden und falls nicht vorhanden, erst dann soll die Datei im aktuellen Monatsordner gespeichert werden.
\\server\maschine\auftraege
unterordner: 2012, 2013, 2014, 2015 usw
unterordner: 01, 02, 03, 04, 05, 06, 07, 08, 09, 10, 11, 12
das Prüf-code sieht im Moment so aus:
datei = anr & ".xls"
If Dir(sPfad & datei) "" Then
Workbooks.Open Filename:=sPfad & datei
ThisWorkbook.Close savechanges:=False 'Vorlage ohne Änderungen schließen
Exit Sub
End If
hier ein link vom arhiv-thread, das funktionierende makro befindet sich ganz unten
http://bit.do/makrospeichern
siehe dort "Wenn Datei mit der eingegebenen Autragsnummer schon vorhanden ist, wird sie geöffnet"
gruss
makedonec

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

Betreff
Datum
Anwender
Anzeige
AW: bestimmte datei auch im unterordner suchen
14.08.2015 21:26:49
Sepp
Hallo ?
deine Infos sind etwas dürftig!
Das könnte in etwa so funktionieren.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Sub test()
Dim a() As Object
Dim result As Long
Dim strFile As String, strPath As String, strName As String

strName = "?" 'Dateiname - woher? - Anpassen!

strPath = "\\server\maschine\auftraege"

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

strFile = strName & ".xls"

result = FileSearchFSO(a, strPath, strFile, True)

If result <> 0 Then
  Workbooks.Open a(0).Path
  ThisWorkbook.Close False
Else
  strPath = strPath & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\"
  If MakeSureDirectoryPathExists(strPath) <> 0 Then
    ThisWorkbook.SaveAs strPath & strFile, 56
  End If
End If

End Sub


Private Function FileSearchFSO(ByRef Files() As Object, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
  Optional ByVal SubFolders As Boolean = False) As Long




'# PARAMETERINFO:
'# Files: Datenfeld zur Ausgabe der Suchergebnisse
'# InitialPath: String der das zu durchsuchende Verzeichnis angibt
'# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard="*.*" findet alle Dateien)
'# Beispiele: "*.txt" - Findet alle Textdateien
'# "*name*" - Findet alle Dateien mit "name" im Dateinamen
'# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)
'# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard=False)


Dim mobjFSO As Object, mfsoFolder As Object, mfsoSubFolder As Object, mfsoFile As Object
Dim intC As Integer, varFiles As Variant

Set mobjFSO = CreateObject("Scripting.FileSystemObject")

Set mfsoFolder = mobjFSO.GetFolder(InitialPath)

On Error GoTo ErrExit

If InStr(1, FileName, ";") > 0 Then
  varFiles = Split(FileName, ";")
Else
  Redim varFiles(0)
  varFiles(0) = FileName
End If

For Each mfsoFile In mfsoFolder.Files
  If Not mfsoFile Is Nothing Then
    For intC = 0 To UBound(varFiles)
      If LCase(mobjFSO.GetFileName(mfsoFile)) Like LCase(varFiles(intC)) Then
        If IsArray(Files) Then
          Redim Preserve Files(UBound(Files) + 1)
        Else
          Redim Files(0)
        End If
        Set Files(UBound(Files)) = mfsoFile
        Exit For
      End If
    Next
  End If
Next

If SubFolders Then
  For Each mfsoSubFolder In mfsoFolder.SubFolders
    FileSearchFSO Files, mfsoSubFolder, FileName, SubFolders
  Next
End If

If IsArray(Files) Then FileSearchFSO = UBound(Files) + 1
ErrExit:
Set mobjFSO = Nothing
Set mfsoFolder = Nothing
End Function


Gruß Sepp

Anzeige
AW: bestimmte datei auch im unterordner suchen
17.08.2015 13:32:15
makedonec
hallo sepp danke dass du schnell geantwortet hast,
ich weiß es liegt an meine deutschkenntnise. ich nehme an dass dein code auch funktionieren wird
ich hab aber das Problem ähnlich gelöst, ich trottel...
hatte sogar so ein ähnliches makro....
es hat lange gedauert bis es angepasst wurde, da wenig vba kenntnise... jedes mal ein fehler korrigiert mit AHAAAAAA deswegen funzt nicht
jetzt funzts es aber perfekt *lautfreu*
hier ein teil-auschnitt vor der anpassung:
VIELEN DANK
makedonec
Option Explicit
Option Base 1
Sub Macedonec()
Dim strMeldung As String, strTitel As String, strAntwort As Integer
Dim Name1 As String 'Ordner- bzw Dateiname
Dim pfad1 As String '1. Teil des Pfades
Dim pfad2 As String 'kompletter Pfad
Dim datei As String 'Dateiname
Dim Home As String 'ThisWorkbook
Dim arr() As String 'Array für Ordnernamen
Dim a As Long 'Index für arr()
Dim m As Integer 'Maschinen#
Dim monat As Integer 'Monats#
'********************************************************************************
' Initialisierung
'********************************************************************************
Home = ThisWorkbook.Name
datei = ActiveSheet.Range("C6"zwinkernder Smilie (ironisch)
'********************************************************************************
'Schleife 1 - MaschinenEbene
'********************************************************************************
For m = 1 To 2
'die Ordner für Jahr und Monat werden in den Programmschleifen angehängt
pfad1 = "\\server\maschine" & m & "\auftraege\"
'pfad1 = "C:\Users\Public\Documents\Anwendungen\macedonec" & m & "\" 'nur für Testzwecke
'********************************************************************************
' Schleife 2 - Alle Jahres-Ordnernamen auslesen, die mit 'pfad1' beginnen
'********************************************************************************
a = 0
Erase arr
Name1 = Dir(pfad1 & "*", vbDirectory) ' Ersten Ordner-Eintrag abrufen.
Do While Name1 "" ' Schleife beginnen.
'Aktuelles und übergeordnetes Verzeichnis ignorieren.
If Name1 "." And Name1 ".." Then
If (GetAttr(pfad1 & Name1) And vbDirectory) = vbDirectory Then 'es handelt sich um ein gewünschtes Verzeichnis
a = a + 1 'Index für arr aktualisieren
ReDim Preserve arr(1 To a) 'arr um einen Eintrag erweitern, bisherige Daten bleiben erhalten
arr(a) = Name1 'speichern nächsten gültigen Ordnernamen in arr
End If
End If
Name1 = Dir ' Nächsten Eintrag abrufen.
Loop
'*******************************************************************************
' Schleife 3 - alle Monats-Ordner nach Datei durchsuchen
'*******************************************************************************
For a = 1 To UBound(arr)
For monat = 1 To 12
pfad2 = pfad1 & arr(a) & "\" & monat & "\" & datei & ".xls" 'Gesamt-Pfad
Name1 = Dir(pfad2)
If Name1 "" Then
Workbooks.Open Filename:=pfad2 'gefundene Datei öffnen
With ThisWorkbook 'dieses Workbook sichern und schließen
.Save
.Close
End With
Exit Sub
End If
Next monat
Next a 'nächsten Ordner verarbeiten
'*******************************************************************************
'Datei nicht gefunden
'*******************************************************************************
rest gelöscht
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige