AW: bei inizialize userform Funktion ausfürhen
23.08.2006 14:41:03
Sebastian
Hi Eule,
mit Hilfe der Funktion Pfad werden aus einem Verzeichnis die Namen der darin enthaltenen Textfiles ausgelesen und in einer Listbox aufgelistet.
Public
Function Pfad() As String
'***************************************** Der User wählt den Pfad, in dem sich die zu bearbeitenden txt Files befinden
'***************************************** In Listbox1 werden die einzelnen Funktionen aufgelistet
Dim datChanged As Variant
Dim i As Integer
Dim START_PATH As String
Dim nItems As Collection
Dim l As Long
Dim nListCount As Long
Dim aki As String
Dim k As Integer
Dim str As String
Dim newMap As Object
Dim objNewMap As Object
aki = ordner
START_PATH = verzTMP
Me.ListBox1.Clear
i = 0
'***************************** strFile = ... \Classify\ --> konstant angegeben, weil stets in dieem Ordner die txt-Files sind.
strFile = Dir(START_PATH & "*.*", vbNormal) '<<<<<<< vbNormal = normale Dateien, also nicht schreibgeschützte
Do While Len(strFile) > 0
'**************************************************** Sollte das Datum eine Rolle spielen dann wird auskommentierter Code relevant
'datChanged = FileDateTime(START_PATH & "\" & strFile)
'If datChanged >= #12/5/2001# And datChanged <= #12/7/2006 11:59:59 PM# Then
'Me.ListBox1.AddItem strFile, i
Teil = CutString(strFile)
'Me.ListBox1.List(i, 1) = Format(datChanged, "dd.mm.yyyy hh:nn")
i = i + 1
'End If
strFile = Dir
Me.ListBox1.AddItem Teil
Loop
With ListBox1
nListCount = .ListCount
Set nItems = New Collection
On Error Resume Next
Do
nItems.Add Empty, .List(l)
If Err.Number Then
.RemoveItem l
nListCount = nListCount - 1
Err.Clear
Else
l = l + 1
End If
Loop Until l = nListCount
End With
'********************************************************* hier wird geprüft ob für die Funktionen bereits ein
'********************************************************* xls-File im AKI Ordner besteht; gegebenenfalls wird
'********************************************************* es angelegt
For k = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(k) = False Then
ListBox1.Selected(k) = True
End If
str = str & ListBox1.List(k)
If str <> "" Then
With Application.FileSearch
.LookIn = aki
.MatchTextExactly = True
.Filename = str & ".xls"
If .Execute Then
GoTo ende:
Else:
Set newMap = Workbooks.Add
With newMap
.SaveAs Filename:=aki & str & ".xls"
.Close
End With
End If
End With
End If
ende:
str = ""
Next k
End Function