Running same process in a folder

Posted on 2004-09-07
Last Modified: 2010-05-02

I have a VB app that does this process in order:
1) Open a folder and for each file, delete the last 3 lines
2) Use the commondialog control to open a file in the same folder
3) Extract pertinent information from that file (the location of each extracted string is in the same place every time)
4) API usage: import the file into a specialized database

How would you automate this process so that in step 1 & 2, I won't have to choose a folder and file manually, it'll extract all the info I need for every file in the folder? The way I was thinking this app would run is if it monitors a folder periodically and if it notices that more files got added into it,
run the above process.

Also, how would you make this app like a service or something that starts up when Windows does?

Here's my code:

Option Explicit

'** For step 4 **
'Step 4 API usage

'** For step 1 **
'Opens a treeview custom control to browse to a folder to convert .wma's
Private sBuffer As String

Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" _
                                  (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" _
                                  (ByVal pidList As Long, _
                                  ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
                                  (ByVal lpString1 As String, ByVal _
                                  lpString2 As String) As Long

Private Type BrowseInfo
   hWndOwner      As Long
   pIDLRoot       As Long
   pszDisplayName As Long
   lpszTitle      As Long
   ulFlags        As Long
   lpfnCallback   As Long
   lParam         As Long
   iImage         As Long
End Type

'End custom control

'** For step 1 **
'Deletes the last 3 lines of backuped .wma files so it can be read into VB
Private Sub deleteLine(line As Integer, fileStr As String)

    Dim sLine As String
    Dim sFile As String
    Dim ff As Integer
    ff = FreeFile

    Open fileStr For Input As #ff
    Dim lineNum As Integer
    lineNum = 0
    While Not EOF(ff)
       'in case you want to delete by line number
       lineNum = lineNum + 1
       Line Input #ff, sLine
       'just an example you could also see if strLine = the line you want to delete
       If lineNum <> line Then
           sFile = sFile & sLine & vbCrLf
       End If
    Close (ff)
    ff = FreeFile
    Open fileStr For Output As #ff
    Print #ff, sFile
    Close (ff)

End Sub

'** For step 1 **
'Opens a Treeview control that displays the folders in a computer
Private Sub cmdConvertFolder_Click()

    Dim lpIDList As Long
    Dim szTitle As String
    Dim response As Integer
    Dim tBrowseInfo As BrowseInfo

    szTitle = "This is the title"
    With tBrowseInfo
       .hWndOwner = Me.hWnd
       .lpszTitle = lstrcat(szTitle, "")
    End With

    'lpIDList = SHBrowseForFolder(tBrowseInfo) 'original place

    If (lpIDList) Then
       sBuffer = Space(MAX_PATH)
       SHGetPathFromIDList lpIDList, sBuffer
       sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
       'MsgBox sBuffer
    End If
    response = MsgBox("Did you backup your .wma files? All .wma files in this folder will be converted!", vbExclamation + vbYesNoCancel, "ECS Importer")
    If response = vbYes Then
        lpIDList = SHBrowseForFolder(tBrowseInfo) 'moved to go w/ the vbYes response
        OpenPath sBuffer, ".wma"
        'do nothing
    End If
End Sub

'Part of the above sub
Private Sub OpenPath(strPath As String, Optional extension As String)
   'Leave Extension blank for all files
   Dim File As String
   If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
   If Trim$(extension) = "" Then
       extension = "*.*"
   ElseIf Left$(extension, 2) <> "*." Then
       extension = "*." & extension
   End If
   File = Dir$(strPath & extension)
   Do While Len(File)
       deleteLine 3, File
       File = Dir$
End Sub

'** Step 2 & 3 **
'Opens commond dialog box to find which file you want to extract
Private Sub cmdRead_Click()
    On Error Resume Next
    Dim strFileLine As String
    Dim strOfficer As String
    Dim strDate As String
    Dim strYear As String
    Dim strMonth As String
    Dim strDay As String
    Dim strStartTime
    Dim strEndTime
    Dim strStartHour As String
    Dim strStartMin As String
    Dim strStartSec As String
    Dim strEndHour As String
    Dim strEndMin As String
    Dim strEndSec As String
    With CommonDialog1
        'raise an error if cancel was hit
        .Filter = ".wma files (*.wma)|*.wma|" & "All files (*.*)|*.*"
        .Flags = cdlOFNHideReadOnly
        .CancelError = True
        ' 32755 is the cancel error raised
        If Err.Number = 32755 Then
            Exit Sub
            Open CommonDialog1.FileName For Input As #1
            Line Input #1, strFileLine 'All the information in the .wma file ready to extract
            Close #1
        End If
    End With
    txtDoc.Text = CommonDialog1.FileTitle
    txtOfficer.Text = Mid(strFileLine, 56, 4)
    strDate = Mid(strFileLine, 79, 6)
    strMonth = Mid(strDate, 3, 2)
    strDay = Mid(strDate, 5, 2)
    strYear = Mid(strDate, 1, 2)
    txtDate.Text = strMonth & "/" & strDay & "/" & strYear
    strStartHour = Mid(strFileLine, 85, 2)
    strStartMin = Mid(strFileLine, 87, 2)
    strStartSec = Mid(strFileLine, 89, 2)
    strEndHour = Mid(strFileLine, 97, 2)
    strEndMin = Mid(strFileLine, 99, 2)
    strEndSec = Mid(strFileLine, 101, 2)

    txtStartTime.Text = strStartHour & ":" & strStartMin & ":" & strStartSec
    txtEndTime.Text = strEndHour & ":" & strEndMin & ":" & strEndSec
End Sub

'** Step 4 **
'Inserts the info into LF
Private Sub cmdInsert_Click()
    Dim strCreateDoc As String
    Dim strImport As String
    LFAPI.LoginEx "ECS Demo 6", "admin", "admin"
    LFAPI.CreateFolder "WMA", "ECS Demo 6"
    strImport = LFAPI.ImportElectronicFile _
    (CommonDialog1.FileName, "ECS Demo 6\WMA", txtDoc.Text, , , "WMA")
    LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Officer", txtOfficer.Text
    LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Date", txtDate.Text
    LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Start Time", txtStartTime.Text
    LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "End Time", txtEndTime.Text
    MsgBox "Document successfully created in LaserFiche.", vbInformation, "ECS Importer"
End Sub

Question by:Trancedified
  • 2
LVL 76

Assisted Solution

GrahamSkan earned 250 total points
ID: 11999277

This would do part 1 as described.

Sub DeleteLast3Lines(MyFolder as string. Pattern as string)
'Pattern might be "*.txt"
Dim f As Integer
Dim g As Integer
Dim strFile As String
Dim LineCount As Integer
Dim TextLine As String
strFile = Dir$(MyFolder & "\" & Pattern)
Do Until strFile = ""
    f = FreeFile
    Open MyFolder & "\" & strFile For Input As f
        LineCount = 0
        Do Until EOF(f)
            Line Input #f, TextLine
            LineCount = LineCount + 1
    Close #f
    f = FreeFile
    Open MyFolder & "\" & strFile For Input As f
        g = FreeFile
        Open MyFolder & "\" & strFile & "New" For Input As g
            Do Until LineCount = 3
                Line Input #f, TextLine
                Print #g, TextLine
                LineCount = LineCount - 1
        Close #g
    Close #f
    Kill MyFolder & "\" & strFile
    Name MyFolder & "\" & strFile & "New" As MyFolder & "\" & strFile
End Sub
LVL 22

Accepted Solution

danaseaman earned 250 total points
ID: 12002014
To monitor a folder for changes you need to use FindFirstChangeNotification API. There is a good example on Planet-Source-Code by Vlad Vissoultchev - Compact In-Process Multi-threading: A FolderWatcher with sample UI (

You can monitor for particular types of changes by ORing any combination of the following flags:

FILE_NOTIFY_CHANGE_FILE_NAME (renaming, creating, or deleting a file)
FILE_NOTIFY_CHANGE_DIR_NAME (creating or deleting a directory)

Note: planet-source-code .zip downloads are unvailable at the moment due to Hurricane Frances. ISP is working on restoring it as soon as possible.

To automatically start your application when Windows starts you can add a new process using Custom Startup. Download here: 


Author Comment

ID: 12007771

My mistake, how would you automate steps 2 & 3, sorry not steps 1 & 2.

danaseaman, I"ll check out both sites, too bad about the hurricane :(


Author Comment

ID: 12030586
I found another way to do it but I will reward points anyway :)


Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

828 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question