Running same process in a folder


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

Who is Participating?

Improve company productivity with a Business Account.Sign Up

danaseamanConnect With a Mentor Commented:
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: 

GrahamSkanConnect With a Mentor RetiredCommented:

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
TrancedifiedAuthor Commented:

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 :(

TrancedifiedAuthor Commented:
I found another way to do it but I will reward points anyway :)

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.