Anzeige
Archiv - Navigation
180to184
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
180to184
180to184
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

dateien ohne pfad

dateien ohne pfad
17.11.2002 13:43:33
Steffen
Hallo Leute,

folgendes habe ich vor:

Ich möchte alle Dateien eines Verzeichnises einlesen, aber ohne Pfadangabe!

Und dann möchte ich alle diese öffnen sofern eine Spalte daneben ein X steht!

Leider habe ich dafür überhaupt keinen anhaltspunkt muss es aber für die Firma hinbekommen!

Danke schonmal

Steffen

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Ansatz auch gefunden --> bitte nochmal helfen
17.11.2002 14:55:38
Steffen
Erst mal danke Hans,

ich habe auch ein Makro gefunden:

Sub DateienEinlesen()
Dim FileArray()
Dim i%, n%
Dim Ordner$, Extension$, dName$
Ordner = InputBox("Verzeichnis:", , "c:\eigene dateien")
Extension = InputBox("Dateityp:", , "*.xls")
ChDrive Left(Ordner, 1)
ChDir Ordner
dName = Dir(Extension)
Do While dName <> ""
n = n + 1
ReDim Preserve FileArray(1 To n)
FileArray(n) = dName
dName = Dir()
Loop
For i = 1 To n
ActiveSheet.Cells(i, 2) = FileArray(i)
Next
End Sub


Leider beginnt dieses Makro immer bei Zeile 1 wenn ich in der Zeile:

For i = 1 To n
ActiveSheet.Cells(i, 2) = FileArray(i)
Next

den Wert i auf 6 setze fängt Excel zwar in der 6 Zeile an, aber läßt auch alle vorangegangen Dateien weg, wie muss ich das ändern!!!

Danke nochmals


Steffen

PS: geht Dein Makro auch mit Excel 97, weil manche Benutzer leider immernoch EXcel 97 einsetzen?!


Anzeige
Re: Ansatz auch gefunden --> bitte nochmal helfen
17.11.2002 15:00:22
Hans W. Herber
... mein Makro funktioniert auch in Excel97. Da ich mir schonmal die Arbeit gemacht habe, eine Beispielarbeitsmappe zu erstellen, verzichte ich darauf, zusätzlich noch in fremden Codes rumzumengen.
Ich bitte um Verständnis, denn dann hätte ich mir die Arbeit sparen können.

hans

Danke
17.11.2002 15:02:08
Steffen
Danke Danke Danke Hans,

wenns mit EXcel 97 fuzt dann nehm ich das

suuuuuuuuuuuuppppppppppppeeeeeeeeeeeeeeeeerrrrrrrrrrrrrr

Steffen

Leider gehts trotzdem noch nicht ganz --> Hilfe
17.11.2002 15:42:23
Steffen
Hallo hans ich habe mir mein MAkro jetzt angepasst,

ich bekomm bloß das öffnen Makro nicht hin!!!!

Mein Code:

Sub DateiEinlesen()
Dim iCounter As Integer
With Application.FileSearch
.LookIn = Cells(ActiveCell.Row - 1, ActiveCell.Column).Value
.Filename = "*." & Cells(ActiveCell.Row - 1, ActiveCell.Column + 1).Value
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter + 6, ActiveCell.Column).Value = Dir(.FoundFiles(iCounter))
Next iCounter
End With
End Sub


Sub OpenFiles()
Dim wks As Worksheet
Dim iRow As Integer
Dim sPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wks = ActiveSheet
iRow = 1
sPath = Cells(ActiveCell.Row - 1, ActiveCell.Column).Value
On Error GoTo ERRORHANDLER
Do Until IsEmpty(wks.Cells(iRow, 1))
iRow = iRow + 1
If LCase(wks.Cells(iRow, ActiveCell.Column+1).Value) = "x" Then
Workbooks.Open sPath & "\" & wks.Cells(iRow, 1).Value, False
End If
Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Wo muss ich im open MAkro ändern, damit ich die richtige Zeile und Spalte für den Dateiname und das X finde

Und zwar s

danke steffen

Anzeige
Re: Leider gehts trotzdem noch nicht ganz --> Hilfe
17.11.2002 15:49:25
Hans W. Herber
... ich versuche, mit sprechenden Namen zu arbeiten, also ist iRow die Zeile und iCol die Spalte. Wenn "Und zwar s" heißen soll, dass das X in Spalte S steht, dann wäre das also:
If LCase(wks.Cells(iRow, 19).Value) = "x" Then

hans

angepasst --> trotzdem noch Problem --> Hilfe
17.11.2002 16:38:09
Steffen
ICh weis ich nerve,

aebr dies ist jetzt die letzte Frage zu diesem Thema

MeinCode jetzt:

Sub DateienÖffnen()
Dim wks As Worksheet
Dim iRow As Integer
Dim sPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wks = ActiveSheet
iRow = 7
sPath = Cells(ActiveCell.Row - 1, ActiveCell.Column).Value
On Error GoTo ERRORHANDLER
Do Until IsEmpty(wks.Cells(iRow, ActiveCell.Column))
iRow = iRow + 1
If LCase(wks.Cells(iRow, ActiveCell.Column + 1).Value) = "x" Then
Workbooks.Open sPath & "\" & wks.Cells(iRow, ActiveCell.Column).Value, False
End If
Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Leider wird jetzt nur noch eine Datei geöffnet und nicht alle in der Liste mit einem X

Danke schonmal

Steffen

Anzeige
Re: angepasst --> trotzdem noch Problem --> Hilfe
17.11.2002 16:43:10
Hans W. Herber
... das ist wegen Deinem überflüssigen "ActiveCell", setze dafür die Spaltennummer. In dem Moment, in dem eine neue Arbeitsmappe geöffnet wird, befindet sich ActiveCell dort und nicht in der Ursprungsmappe.

hans

Nochmals Danke --> mein Code jetzt
18.11.2002 18:58:26
Steffen
Danke Steffen

Sub DateiEinlesen()
On Error GoTo ERRORHANDLER
Dim iCounter As Integer
With Application.FileSearch
.LookIn = Cells(ActiveCell.Row - 1, ActiveCell.Column).Value
.Filename = "*." & Cells(ActiveCell.Row - 1, ActiveCell.Column + 1).Value
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter + 7, ActiveCell.Column).Value = Dir(.FoundFiles(iCounter))
Next iCounter
End With
ERRORHANDLER:
End Sub

Sub Dateienoeffnen()
Dim PSWD As String
'Passwort für Dateischutz
PSWD = Workbooks(ThisWorkbook.Name).Sheets("aeinstellung").Range("C5").Value

Dim wks As Worksheet
Dim iRow As Integer
Dim sPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wks = ActiveSheet
iRow = 7
sPath = Cells(ActiveCell.Row - 1, ActiveCell.Column).Value
On Error GoTo ERRORHANDLER
Do Until IsEmpty(wks.Cells(iRow, ActiveCell.Column))
iRow = iRow + 1
If LCase(wks.Cells(iRow, ActiveCell.Column + 1).Value) = "x" Then
If IstMappeOffen(sPath & "\" & wks.Cells(iRow, ActiveCell.Column).Value) = False Then
Workbooks.Open sPath & "\" & wks.Cells(iRow, ActiveCell.Column).Value, False
Workbooks(ThisWorkbook.Name).Activate
Sheets("ADateien").Select
Else
End If
End If

Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige