Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datein eines Ordners öffnen und prüfen?

Datein eines Ordners öffnen und prüfen?
03.01.2006 15:22:49
Gustav
Hallo, gibt es eine Möglichkeit alle Excel-Dateien eines Ordners der Reihe nach zu öffnen, jeweils die Summe der Spalte C zu überprüfen und bei der Summe 0 die Datei in den Unterordner "Leer" zu verschieben? Wenn die Summe ungleich 0 ist, soll die Datei einfach wieder geschlossen werden.
Vielen Dank für die Anregungen.
Gustav

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datein eines Ordners öffnen und prüfen?
03.01.2006 16:47:00
Josef
Hallo Gustav!
Spalte C in welchem Tabellenblatt (Name) ?
Haben die Tabellen immer den gleichen Namen?
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Datein eines Ordners öffnen und prüfen?
03.01.2006 17:38:53
Josef
Hallo Gustav!
Ich nehme mal an, das die Tabellen immer den selben Namen haben!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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

Sub GetSumAndMove()
Dim strPath As String, strMove As String, strSheet As String, strRange As String
Dim objFS As FileSearch, objFSO As Object
Dim lngIndex As Long, varResult As Variant

'#### Diese Angaben anpassen #######################

'zu untersuchendes Verzeichnis
strPath = "F:\Temp\"

'Ordner in den die Dateien verschoben werden sollen!
strMove = "F:\Temp\Leer"

'Name des Tabellenblattes!
strSheet = "Tabelle1"

'Bereich dessen Summe gebildet werden soll!
strRange = "C:C"

'###################################################


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

MakeSureDirectoryPathExists strMove

Set objFS = Application.FileSearch
Set objFSO = CreateObject("Scripting.FileSystemObject")

With objFS
  .NewSearch
  .LookIn = strPath
  .FileType = msoFileTypeExcelWorkbooks
  .SearchSubFolders = False
  .Execute
  
  For lngIndex = 1 To .FoundFiles.Count
    
    varResult = GetValue(strPath, Replace(.FoundFiles(lngIndex), strPath, ""), strSheet, strRange)
    
    If IsNumeric(varResult) And varResult = 0 Then
      objFSO.MoveFile .FoundFiles(lngIndex), strMove
    End If
    
  Next
  
End With

Set objFS = Nothing
Set objFSO = Nothing

End Sub


Private Function GetValue(path As String, file As String, _
  sheet As String, ref As String) As Variant


Dim arg As String

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

If Dir(path & file) = "" Then
  GetValue = "File Not Found"
  Exit Function
End If

arg = "SUM('" & path & "[" & file & "]" & sheet & "'!" & _
  Range(ref).Address(, , xlR1C1) & ")"

GetValue = ExecuteExcel4Macro(arg)

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Datein eines Ordners öffnen und prüfen?
04.01.2006 08:05:29
Gustav
Hallo Sepp,
die Spalte C liegt in dem Tabellenblatt "Gesamtübersicht".
Die Dateien haben nie den gleichen Namen. Sie bestehen aber immer aus einem Tabellenblatt mit den Namen "Gesamtübersicht"
Dateien liegen in "C:\Temp\Innenauftrag" und sollen nach "C:\Temp\Innenauftrag\leer".
Wenn das klappt wärs echt super...
Besten Dank vorab Gustav
AW: Datein eines Ordners öffnen und prüfen?
04.01.2006 10:04:54
Josef
Hallo Gustav!
Hast du meinen Code Probiert?
Die Pfade und den Blattnamen musst du anpassen!
Ich habe die Stellen genau gekennzeichnet!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Datein eines Ordners öffnen und prüfen?
04.01.2006 11:54:28
Gustav
Mensch Sepp,
das läuft astrein. Am Ende gibt er zwar eine Fehlermeldung aus,
aber das Makro leistet ganze Arbeit.
Da hast Du mir wirklich weitergeholfen.
Vielen Dank und ein tolles Jahr 2006!
Gustav
AW: Datein eines Ordners öffnen und prüfen?
04.01.2006 12:27:38
Josef
Hallo Gustav!
Die Fehlermeldung kommt z.B. wenn du Verknüpfungen zu "*.xls" Dateien in dem Ordner stehen hast!
Das lässt sich auch abfangen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


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

Sub GetSumAndMove()
Dim strPath As String, strMove As String, strSheet As String, strRange As String
Dim objFS As FileSearch, objFSO As Object
Dim lngIndex As Long, varResult As Variant

'#### Diese Angaben anpassen #######################

'zu untersuchendes Verzeichnis
strPath = "F:\Temp\"

'Ordner in den die Dateien verschoben werden sollen!
strMove = "F:\Temp\Leer"

'Name des Tabellenblattes!
strSheet = "Tabelle1"

'Bereich dessen Summe gebildet werden soll!
strRange = "C:C"

'###################################################


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

MakeSureDirectoryPathExists strMove

Set objFS = Application.FileSearch
Set objFSO = CreateObject("Scripting.FileSystemObject")

With objFS
  .NewSearch
  .LookIn = strPath
  .FileType = msoFileTypeExcelWorkbooks
  .SearchSubFolders = False
  .Execute
  
  For lngIndex = 1 To .FoundFiles.Count
    
    If objFSO.GetExtensionName(.FoundFiles(lngIndex)) = "xls" Then
      
      varResult = GetValue(strPath, Replace(.FoundFiles(lngIndex), strPath, ""), strSheet, strRange)
      
      If IsNumeric(varResult) And varResult = 0 Then
        objFSO.MoveFile .FoundFiles(lngIndex), strMove
      End If
      
    End If
    
  Next
  
End With

Set objFS = Nothing
Set objFSO = Nothing

End Sub



Private Function GetValue(path As String, file As String, _
  sheet As String, ref As String) As Variant


Dim arg As String

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

If Dir(path & file) = "" Then
  GetValue = "File Not Found"
  Exit Function
End If

arg = "SUM('" & path & "[" & file & "]" & sheet & "'!" & _
  Range(ref).Address(, , xlR1C1) & ")"

GetValue = ExecuteExcel4Macro(arg)

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige