Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


Running same process in a folder

Posted on 2004-09-07
Medium Priority
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 77

Assisted Solution

GrahamSkan earned 1000 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 1000 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 (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=36373&lngWId=1).

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: http://www.gboban.com 


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

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

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

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…
Suggested Courses

572 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