Hallo mal wieder 
Habe - ich weiss ned ob sich noch wer dran errinnert - die Filesuche aus Excel/VBA in VB5 nun geschrieben, bzw bin ich grad dabei.
Soweit so gut.
Hier der VB5 Coder -->
Option Explicit
Private Sub Form\_Activate()
Dim Datum As Date
Datum = Format(Now, "dd.mm.yyyy")
txtKW = KalenderWoche(Datum)
txtDatum = Format(Now, "dd.mm.yyyy hh.mm.ss")
DTPicker3.Value = Now
cmdRechnungKopieren.Enabled = False
End Sub
Private Sub cmdShareÖffnen\_Click()
Dim strDirPath As String
strDirGesamt = "Z:\test\"
Shell "explorer.exe /e, " & strDirGesamt, vbNormalFocus
End Sub
Private Sub cmdRechnungSuchen\_Click()
Dim sInhalt As String
Dim strDirDate As String
Dim strSender As String
Dim strVerzeichnis As String
Dim pfad1 As String
Dim pfad2 As String
Dim Split As Variant
Dim nDate As Date
Dim pfad As String
Dim Suchbegriff As String
Dim objShell As Variant
Dim CommandLine As Variant
Dim objExecObject As Variant
Dim Filelist As String
Dim i As Integer
**Dim UBound As String**
If OptionButton1.Value = True Then
strVerzeichnis = "Z:\test1"
End If
If OptionButton2.Value = True Then
strVerzeichnis = "Z:\test2"
End If
If OptionButton3.Value = True Then
strVerzeichnis = "Z:\test3"
txtSenderID = ""
End If
strDirDate = DTPicker3
strSender = txtSenderID
nDate = Format(DTPicker3, "yymmdd")
strDirDate = nDate
sInhalt = txtSuchBox
pfad1 = strVerzeichnis & "\" & strDirDate & "\" & strSender & "\*.\*"
pfad2 = strVerzeichnis & "\" & "" & "\" '& strSender
If CheckBox1.Value = True Then
pfad = pfad2
Else
pfad = pfad1
End If
Label2 = pfad
Suchbegriff = txtSuchBox
ListBox2.Clear
If txtSpeicherPfad = "" Then
MsgBox "Bitte erst Ordner anlegen"
cmdOrdnerAnlegen.SetFocus
Else
If txtSuchBox = "" Then
txtSuchBox = "\*"
Else
Set objShell = CreateObject("WScript.Shell")
CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & pfad & """ "
Set objExecObject = objShell.Exec(CommandLine)
If Not objExecObject.StdOut.AtEndOfStream Then
Filelist = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
For i = 0 To UBound(Filelist) - 1
ListBox2.AddItem Filelist(i)
Next
Else
MsgBox "Datei nicht gefunden"
txtSuchBox.SetFocus
End If
End If
End If
End Sub
Private Sub cmdRechnungKopieren\_Click()
Dim strDirDate As String
Dim strDirPath As String
Dim strCopyVon As String
Dim strSender As String
Dim pfad As String
Dim i As Long
nDate = Format(frmTickets.DTPicker3, "yymmdd")
strDirDate = nDate
strSender = txtSenderID
strDirPath = txtSpeicherPfad
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
strCopyVon = ListBox2.List(i)
strCopyVonPath = Left(strCopyVon, InStrRev(strCopyVon, "\") - 1)
strCopyVonFolder = Mid(strCopyVonPath, InStrRev(strCopyVonPath, "\") + 1)
CreateObject("Scripting.FileSystemObject").CopyFolder strCopyVonPath, strDirPath & "\" & strCopyVonFolder
End If
Next i
End Sub
Private Sub cmdOrdnerÖffnen\_Click()
Dim strDirPath As String
strDirPath = txtSpeicherPfad
Shell "explorer.exe /e, " & strDirPath, vbNormalFocus
End Sub
Private Sub CommandButton8\_Click()
Dim Path As String
Dim Pic As String
If ListBox2.ListIndex = -1 Then
MsgBox "Keine Einträge vorhanden!", vbCritical
Exit Sub
End If
Path = Left(ListBox2.List(ListBox2.ListIndex), InStrRev(ListBox2.List(ListBox2.ListIndex), "\"))
If Not (FileExists(ListBox2.List(ListBox2.ListIndex))) Then
MsgBox "BildDatei wurde nicht gefunden!"
Exit Sub
Else
'Hier die Extension prüfen und ggfls. Meldung anzeigen
Label65.Caption = Path
Image1.Picture = LoadPicture(ListBox2.List(ListBox2.ListIndex))
Shell "explorer.exe /e," & Path, vbNormalFocus
End If
End Sub
Private Function FileExists(sFile As String)
On Error Resume Next
Dim x As Integer
x = GetAttr(sFile)
FileExists = Err.Number = 0
End Function
Private Sub List1\_Click()
Call LoadImg
End Sub
Private Sub Image1\_Click()
Dim imgBild As String
imgBild = "C:\Dokumente und Einstellungen\rosenmuellerm\Desktop\test.gif"
End Sub
Private Sub Label62\_Click()
txtSenderID.Text = "0\_0"
End Sub
Private Sub ListBox2\_Change()
cmdRechnungKopieren.Enabled = True
End Sub
Private Sub cmdOrdnerAnlegen\_Click()
Dim strDirPath As String, N As Long, eing
strDirPath = "C:\test\" & txtSenderID & " - " & "KW" & txtKW & " - " & Format(Date, "ddmmyy")
If txtSenderID = "" Then
MsgBox "Bitte Sender\_ID eingeben"
Else
If Dir(strDirPath, vbDirectory) = "" Then
MkDir strDirPath
txtSpeicherPfad = strDirPath
Else
While Dir(strDirPath, vbDirectory) ""
N = N + 1
strDirPath = "C:\test\" & txtSenderID & "\_" & N & " - " & "KW" & txtKW & " - " & Format(Date, "ddmmyy")
Wend
eing = MsgBox("Ordner schon vorhanden - Mit neuer Nummerierung angelegen?", vbOKCancel)
txtSpeicherPfad = "Ordner nicht angelegt"
If eing vbOK Then Exit Sub
txtSpeicherPfad = strDirPath
MkDir strDirPath
End If
End If
End Sub
Private Sub DTPicker3\_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
Dim nDate As Date
End Sub
Private Function KalenderWoche(Datum As Date) As Integer
Dim tmp As Double
tmp = DateSerial(Year(Datum + (8 - WeekDay(Datum)) Mod 7 - 3), 1, 1)
KalenderWoche = (Datum - tmp - 3 + (WeekDay(tmp) + 1) Mod 7) \ 7 + 1
End Function
Private Function Datum\_aus\_Woche(Jahr As Integer, Woche As Integer)
Dim intTag As Integer, intWoche As Integer
If Jahr = 0 Then
Datum\_aus\_Woche = 0
Exit Function
End If
intTag = 1
intWoche = KalenderWoche(DateSerial(Jahr, 1, 1))
If intWoche 1 Then
Do Until KalenderWoche(DateSerial(Jahr, 1, intTag)) = 1
intTag = intTag + 1
Loop
Else
Do Until KalenderWoche(DateSerial(Jahr, 1, intTag)) 1
intTag = intTag - 1
Loop
intTag = intTag + 1
End If
Datum\_aus\_Woche = DateSerial(Jahr, 1, intTag) + (Woche - 1) \* 7
End Function
Sub OptionButton1\_Click()
If OptionButton1.Value = True Then
txtSenderID.Text = "1111\_"
End If
End Sub
Sub OptionButton2\_Click()
If OptionButton2.Value = True Then
txtSenderID.Text = "2222\_"
End If
End Sub
Sub OptionButton3\_Click()
If OptionButton3.Value = True Then
txtSenderID.Text = ""
End If
End Sub
Private Sub txtDate\_Change()
Dim Zeit1
Zeit1 = Time
End Sub
Private Sub cmdEnde\_Click()
Unload frmTickets
End Sub
nun, beid er Suche „Private Sub cmdRechnungSuchen_Click()“ bringt er bei Ubound eben o. g. Fehler --> compile error expected: identifier.
Hat hier jemand ne Idee was ich hier falsch mache. Als was soll UBound deklariert werden?
Gruß Rolf
(