Re: Need Help deleting record from text file
- From: "Norm" <NormF4@xxxxxxxxxxxxxxxxx>
- Date: Wed, 26 Sep 2007 12:38:34 -0700
Dave,
Can you point me to some examples as I do not have any experience with
databases?
Here is what I am doing now with code attached. Seems pretty quick until you
get to a large number of files.
Working with 10,746 files takes 119.64 seconds. I know there has to be a
faster way than this. :-)
Randy will probably recognize a lot of this code as it comes from his site.
Watch for line wrapping.
Code following:
Dim ff As Integer
Dim FileIn As String
Dim tstart As Long
Dim RecordLine() As String
Dim h As Long
Dim sText As String
Dim sCaption As String
Dim x As Integer
Dim tend As Single
Dim TargetPath As String
Dim strFile As String
Dim strSaveFile As String
Dim sPart As String
Dim lne As String
Dim bLneCheck As Boolean
Dim strCheck As String
Dim strPath As String
Dim c As Long
Dim stPath As String
List6.Clear
bLneCheck = False
Command13.Enabled = True
Command16.Enabled = False
Screen.MousePointer = 11
lvSaved.Visible = False
lvSaved.Text = ""
List16.Clear
lvSaved.Refresh
Text3.Visible = True
tstart = GetTickCount()
blnDelList = True
Label5.Caption = "Working Please Wait"
Label5.ForeColor = &HC0&
Label5.Refresh
strCheckList = "Original"
Command17.Enabled = True
Command17.Caption = "Save New File"
Text2.Text = ""
Text2.Refresh
Text1.Text = ""
Text1.Refresh
h = List5.ListIndex
strSaveTargetPath = List5.List(h)
strPath = List5.List(h)
If Len(strSaveTargetPath) > 3 Then
sDriLetter = Left(strSaveTargetPath, 1)
strSaveTargetPath = sDriLetter & Right(strSaveTargetPath,
(Len(strSaveTargetPath) - 3))
Else
strSaveTargetPath = Left(strSaveTargetPath, 1)
End If
List13.Clear
strOutputFile2$ = App.Path & "\" & strSaveTargetPath & ".txt"
If FileExists(strOutputFile2$) = False Then
Text1.Text = "0"
lvSaved.Text = ""
lvSaved.SelText = " No Files In
Original List"
GoTo Continue
End If
Command13.Caption = "Show Saved Files"
ff = FreeFile
Open strOutputFile2$ For Binary As #ff
FileIn = Space(LOF(ff))
Get #ff, , FileIn
Close #ff
FileIn = vbNewLine & FileIn & vbNewLine
c = InStr(1, FileIn, ":\", vbTextCompare)
SavedDir = Mid$(FileIn, (c - 1), 3)
sJob = strPath
bCheck = True
Set strCollection1 = Nothing
Set strCollection1 = New Collection
With FP
.sFileRoot = QualifyPath(strPath) 'Sets backslash at end of path
.sFileNameExt = "*.*"
.bRecurse = 1
.nCount = 0
.nSearched = 0
End With
Call SearchForFiles(FP.sFileRoot) 'This only takes about 7 secs for
10,746 files
bCheck = False
y = strCollection1.Count
Set strCollection2 = Nothing
Set strCollection2 = New Collection
For y = strCollection1.Count To 1 Step -1
If Left$(strCollection1.item(y), 3) = SavedDir Then
stPath = strCollection1.item(y)
Else
stPath = SavedDir & strCollection1.item(y)
End If
stPath = TrimNull(stPath)
h = InStr(1, FileIn, stPath, vbTextCompare)
If h > 0 Then
h = InStr(1, stPath, vbNewLine, vbBinaryCompare)
If h > 0 Then stPath = Left$(stPath, (Len(stPath) -
Len(vbNewLine)))
strCollection2.Add stPath
End If
Next y
y = strCollection2.Count
Kill strOutputFile2$
ff = FreeFile
Open strOutputFile2$ For Output As #ff
For y = strCollection2.Count To 1 Step -1
stPath = strCollection2.item(y)
Print #ff, strCollection2.item(y)
Next y
Close ff
Set strCollection2 = Nothing
Set strCollection1 = Nothing
lvSaved.LoadFile strOutputFile2$, 1
Continue:
Label5.Caption = "List of Original Path Log"
Label5.ForeColor = &H0&
Label5.Refresh
lvSaved.SelStart = Len(lvSaved)
Text1 = lvSaved.GetLineFromChar(lvSaved.SelStart)
lvSaved.SelStart = 0
lvSaved.Visible = True
Text3.Visible = False
tend = GetTickCount
Screen.MousePointer = 0
Text2.Text = FormatNumber((tend - tstart) / 1000, 2) & " Seconds"
This is the routine called to read the files from the saved location, only
takes about 7 secs for 10,746 files.
Private Sub SearchForFiles(sRoot As String)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strPath As String
Dim y As Long
Dim strCheck As String
hFile = FindFirstFile(sRoot & ALL_FILES, WFD)
If hFile <> INVALID_HANDLE_VALUE Then
Do
If bCheck = False Then Exit Sub
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName) <> vbDot Then
If FP.bRecurse Then
SearchForFiles sRoot & TrimNull(WFD.cFileName) &
vbBackslash
End If
End If
Else
If MatchSpec(WFD.cFileName, FP.sFileNameExt) Then
FP.nCount = FP.nCount + 1
If sRoot = sJob & "\" Then
'List13.AddItem TrimNull(WFD.cFileName)
ReDim Preserve strArray1(1, FP.nCount)
strCollection1.Add SavedDir & (WFD.cFileName) &
vbNewLine
Else
strPath = Right$(sRoot, (Len(sRoot) - (Len(sJob) + 1)))
'ReDim Preserve strArray1(1, FP.nCount + 1)
strCollection1.Add strPath & TrimNull(WFD.cFileName) &
vbNewLine
'strCheck = strCollection1.item(FP.nCount)
y = strCollection1.Count
End If
lvSaved.SelText = sRoot & TrimNull(WFD.cFileName) & vbCrLf
End If
End If
FP.nSearched = FP.nSearched + 1
Loop While FindNextFile(hFile, WFD)
End If
Call FindClose(hFile)
y = strCollection1.Count
End Sub
Thanks in advance,
--
Norm
Don't blame me, my programming is
self-taught and my teacher was not
very experienced. :-)
normfowler_don't use_@xxxxxxxxxxx
.
- References:
- Need Help deleting record from text file
- From: Norm
- Re: Need Help deleting record from text file
- From: Dave O.
- Re: Need Help deleting record from text file
- From: David Kerber
- Re: Need Help deleting record from text file
- From: Norm
- Re: Need Help deleting record from text file
- From: Dave O.
- Need Help deleting record from text file
- Prev by Date: Re: Loop without Do
- Next by Date: Thick dash line
- Previous by thread: Re: Need Help deleting record from text file
- Next by thread: Re: Need Help deleting record from text file
- Index(es):
Relevant Pages
|
