Trtko Koprivnica
Član broj: 69494 Poruke: 695 195.29.146.*
|
Azras ,
To ti ide ovako , nisam bas vjest u objasnjavanju , valjda ces skuziti
On error - ti je bitan
ako se desi neka greska u izvrsavanju programa , onda program skoci na
labelu gresi ( unutar nje obradjujes gresku )
Private Sub Command0_Click()
On Error GoTo gresi
If Right(odkud, 1) = "\" Then
Else
odkud = odkud + "\"
End If
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(odkud)
Set fc = f.Files
brk = 0
s = ""
For Each f1 In fc
trt = Right(f1.Name, 12)
dat = Left(trt, 8)
dd = Left(dat, 2)
mm = Mid(dat, 3, 2)
gg = Right(dat, 4)
novid = dd & "/" & mm & "/" & gg
zadat = CDate(novid)
If zadat >= pocdat Then
If zadat <= zavdat Then
If UCase(Right(f1.Name, 3)) = "TXT" Then
brk = brk + 1
s = s & f1.Name & ";"
End If
End If
End If
Next
List10.RowSource = s
Dim pozmen As Integer
For j = 1 To brk - 1
List10.Selected(j) = True
imel.Caption = List10.Column(0, j)
pozmen = 0
pozmen = InStr(1, List10.Column(0, j), "_", vbTextCompare)
novi = Mid(List10.Column(0, j), pozmen + 1, Len(List10.Column(0, j)))
pozmen = InStr(1, novi, "_", vbTextCompare)
brknj.Caption = Left(novi, pozmen - 1)
popa = Mid(novi, pozmen + 1, Len(novi))
pozmen = InStr(1, popa, "_", vbTextCompare)
popr.Caption = Left(popa, pozmen - 1)
trt1 = Right(List10.Column(0, j), 12)
dat = Left(trt1, 8)
dd = Left(dat, 2)
mm = Mid(dat, 3, 2)
gg = Right(dat, 4)
novid = dd & "/" & mm & "/" & gg
zadat = CDate(novid)
datpop = zadat
stoto = odkud + List10.Column(0, j)
prepisi (stoto)
Me.Repaint
Next j
Exit Sub
gresi:
If Err = 76 Then
MsgBox "Ne postoji taj folder ( direktorij ) s podacima"
Exit Sub
else
' sve ostale greske
' javis da se pojavila greska
' i posaljes ga van iz sub
exit sub
End If
End Sub
eto
Pozdrav
Trtko
NE OBAZIRI SE NA KOD UNUTAR !!!
|