Solved

Directory Changed??

Posted on 1998-08-18
11
222 Views
Last Modified: 2011-04-14
SAMPLE CODE NEEDED:     I'm looking for a way to watch a directory, and tell when a new file has arrived, open the file(123456.txt) and get a string from the 5th line 8 spaces
to the right and and rename the file using that string.

 
0
Comment
Question by:rhop
  • 4
  • 4
  • 2
  • +1
11 Comments
 
LVL 1

Accepted Solution

by:
brunchey earned 300 total points
Comment Utility
Put in a loop that uses the dir function to look for the file in the directory.  Once you find it process it. Something like this

Do
   lsFileName = dir('string arg for dir name and file pattern')
   if lsfilename <> vbnullstring then
       'read in the fifth line and process it as necessary
   end if
loop

Also look in the help file for reading and writing to text files, it is not hard at all you need to do an open for input statement, and then a input# statement to get the first line.  Loop until you have the fifth line and then do the left$() function on the fifth line to get your information.  Then use the filecopy function to copy the 123456.txt and rename the file to what you want, then use the kill function to delete the 123456.txt file.
0
 
LVL 14

Expert Comment

by:waty
Comment Utility
I have a better solution wich takes less CPU, memory : use of the file notification system. Here is the source code :

If you need more explanation, samples, don't hesitate to mail me : waty.thierry@usa.net



MFileNotify.Bas
Option Explicit

''@B Data
Public Type TConnection
    sDir As String
    ordType As Long
    fSubTree As Boolean
    objTarget As Object
End Type

' Actually cLastNotify + 1 allowed
Public Const cLastNotify = 28
' One extra blank item in each array for easy compacting
Public ahNotify(0 To cLastNotify + 1) As Long
Public aconNotify(0 To cLastNotify + 1) As TConnection
Public aerr(errFirst To errLast) As String
' Count of connected objects managed by class
Public cObject As Long
''@E Data


''@B Main
Sub Main()
    Dim iStatus As Long, f As Boolean, objTarget As Object
    ' Keep waiting for file change events until no more objects
    Do
        '  Wait 100 milliseconds for notification
        iStatus = WaitForMultipleObjects(Count, ahNotify(0), _
                                         False, 100)
        Select Case iStatus
        Case WAIT_TIMEOUT
            ' Nothing happened
            DoEvents
        Case 0 To Count
            ' Call client object with information
            On Error Resume Next
            With aconNotify(iStatus)
                .objTarget.FileChange .sDir, .ordType, .fSubTree
            End With
            If Err <> 0 Then RaiseError errNoFileChangeMethod
            On Error GoTo 0
            ' Wait for next notification
            f = FindNextChangeNotification(ahNotify(iStatus))
        Case WAIT_FAILED
            ' Indicates no notification requests
            DoEvents
        Case Else
            Debug.Print "Can't happen"
        End Select
    ' Class Initialize and Terminate events keep reference count
    Loop Until cObject = -1
End Sub
''@E Main

Private Property Get Count() As Long
    Dim i As Long
    For i = 0 To cLastNotify
        If ahNotify(i) = INVALID_HANDLE_VALUE Then Exit For
    Next
    Count = i
End Property

Public Sub RaiseError(iErr As Integer)
    Err.Raise vbObjectError + iErr, "FileNotify.CFileNotify", aerr(iErr)
End Sub
----------------------------------------------------------
MFileNotifyError.Bas
Option Explicit

Public Const errFirst = 100
Public Const errInvalidDirectory = 100
Public Const errInvalidType = 101
Public Const errInvalidArgument = 102
Public Const errTooManyNotifications = 103
Public Const errNotificationNotFound = 104
Public Const errNoFileChangeMethod = 105
Public Const errLast = 105

----------------------------------------------------------
CFileNotify.cls

Option Explicit

Private Sub Class_Initialize()
    ' Count this object
    cObject = cObject + 1
    ' Initialize static data only once
    If ahNotify(0) <> 0 Then Exit Sub
    Dim i As Integer
    For i = 0 To cLastNotify
        ahNotify(i) = INVALID_HANDLE_VALUE
    Next
    aerr(errInvalidDirectory) = "Invalid directory"
    aerr(errInvalidType) = "Invalid notification type"
    aerr(errInvalidArgument) = "Invalid argument"
    aerr(errTooManyNotifications) = "Too many notifications"
    aerr(errNotificationNotFound) = "Notification not found"
End Sub

Private Sub Class_Terminate()
    ' Uncount this object
    cObject = cObject - 1
    ' Main loop tests -1 because count is 0 to start
    If cObject = 0 Then cObject = -1
End Sub

''@B Connect
Function Connect(objTarget As Object, sDir As String, _
                ordType As Long, fSubTree As Boolean) As Long
    Connect = INVALID_HANDLE_VALUE ' Assume fail
    Dim i As Long, h As Long
    ' Find blank handle space
    For i = 0 To cLastNotify
        If ahNotify(i) = INVALID_HANDLE_VALUE Then
            ' Set up notification
            h = FindFirstChangeNotification(sDir, fSubTree, ordType)
            Connect = h
            If h = INVALID_HANDLE_VALUE Then
                ' Change notification unsupported on remote disks
                If Err.LastDllError <> ERROR_NOT_SUPPORTED Then
                    RaiseError errInvalidArgument
                End If
                Exit Function
            End If
            ' Store information
            ahNotify(i) = h
            With aconNotify(i)
                Set .objTarget = objTarget
                .sDir = sDir
                .ordType = ordType
                .fSubTree = fSubTree
            End With
            Exit Function
        End If
    Next
    RaiseError errTooManyNotifications
End Function
''@E Connect

''@B Disconnect
Function Disconnect(hNotify As Long) As Boolean
    Dim i As Long, f As Boolean
    For i = 0 To cLastNotify
        If ahNotify(i) = hNotify Then
            ' Destroy notification
            f = FindCloseChangeNotification(hNotify)
            Disconnect = True
            ' Compact the arrays
            Do While i <= cLastNotify
                If ahNotify(i) = INVALID_HANDLE_VALUE Then Exit Do
                ahNotify(i) = ahNotify(i + 1)
                With aconNotify(i)
                    Set .objTarget = aconNotify(i + 1).objTarget
                    .sDir = aconNotify(i + 1).sDir
                    .ordType = aconNotify(i + 1).ordType
                    .fSubTree = aconNotify(i + 1).fSubTree
                End With
                i = i + 1
            Loop
            Exit Function
        End If
    Next
    RaiseError errNotificationNotFound
End Function
''@E Disconnect
'

0
 
LVL 3

Expert Comment

by:SPECIALIST
Comment Utility
I have a program that is far better than the previous examples. this program uses less very few resources, would be invisible, run when your computer is running, take less than 1/2 of the code in the above examples, and constantly monitor the directory(s).

let me know if you want me to post it.

Specialist
0
 
LVL 14

Expert Comment

by:waty
Comment Utility
Specialist,

Is it possible to post it, or send it to me?
thanks

waty.thierry@usa.net
0
 

Author Comment

by:rhop
Comment Utility
Specialist could you please send it to me or post it, waty example is kind-of complex for me or
waty if you could explain how to ?? either way I would be glad to reopen, and award the points to whom ever,  

Thanks Bunch, rhop
rhopkin4@ford.com
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 3

Expert Comment

by:SPECIALIST
Comment Utility
Try this code.  You will need to customize a few things.  I use this code daily it works great.  If you have any problems let me know.  Make sure your read the * at the bottom of the file.

This is the first step.  this will establish a tray icon.  (the key is to put the program in your
windows startup group)  you will want to coustomize this.


Option Explicit

Private Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA

Private Sub Form_Load()
Timer1.Interval = 1000
    t.cbSize = Len(t)
    t.hWnd = pichook.hWnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Me.Icon
    t.szTip = "Shell_NotifyIcon ..." & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Me.Hide
    me.visible=false
    App.TaskVisible = False
    End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    t.cbSize = Len(t)
    t.hWnd = pichook.hWnd
    t.uId = 1&
    Shell_NotifyIcon NIM_DELETE, t
End Sub


Private Sub command10_Click'optional
    Unload Me
End Sub

Private Sub pichook_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static rec As Boolean, msg As Long
    msg = X / Screen.TwipsPerPixelX
    If rec = False Then
    rec=true
    Select Case msg
            Case WM_LBUTTONDBLCLK:
                Shell ("path&filename")'optional customize these to do whatever you want
               
            Case WM_LBUTTONDOWN:
            Case WM_LBUTTONUP:
            Case WM_RBUTTONDBLCLK:
           
           
            Case WM_RBUTTONDOWN:
            Case WM_RBUTTONUP:
                Me.Visible = True'use this to make the app visble so you can exit if you want.
       
        End Select
        rec = False
    End If
End Sub


**********************************************************

you must now establish a timer on your form.

*******************************************
Private Sub Timer1_Timer()
dim path as string

Call File_Exists(path)


'now you must set a find/dir function:

Function File_Exists(ByVal path As String) As Boolean
Dim TextLine
Dim a As String
Dim newfilename As String

path = "C:\windows\desktop\*.txt" ' change to  your dir and exention
       '     'Returns true if the passed path and filename exist
       '     'Otherwise returns false
   File_Exists = IIf(Dir$(path) = "", False, True)
    If File_Exists = False Then Exit Function 'if the .txt file exists
'it will do what you want it to do in the next line:
Dim al As String
al = Dir$(path)
Open ("c:\windows\desktop\" & al) For Input As #1 ' change to your file/path
a = 0
Do Until a = 5
Line Input #1, TextLine ' Read line into variable.
a = a + 1
If a = 5 Then
newfilename = Left(TextLine, 8)
Close #1
End If
Loop

Dim sourcefile, destinationfile ' copy the original file to a new file
sourcefile = "c:\windows\desktop\" & al & ".rpt"  '* SEE NOTE BELOW

destinationfile = "c:\windows\desktop\" & newfilename
FileCopy sourcefile, destinationfile
     
Kill ("c:\windows\desktop\" & al)


End Function

'****  this process will look for any file named ".txt" so after the process finishes, it will
'Rename the tile to ".rpt" all you have to do is double click and choose open with notepad, and your
'computer will recognize this to be opened as text perminently. (you cannot name it .txt, because of the
'timer event it will continue forever in a loop
'on timer event use this  Call File_Exists(path)


0
 
LVL 14

Expert Comment

by:waty
Comment Utility
Specialist, after reading your code, I don't think you need to add the application in the trayicon.

By the way, it is quite the same answer than brunchey.
0
 
LVL 3

Expert Comment

by:SPECIALIST
Comment Utility
no problem, but it is not the same answer.  although part of the answer uses a similar function, because that is the best way to do it,my code is complete. The tray icon is the superior way to do this.  

Regards,

Specialist
0
 
LVL 14

Expert Comment

by:waty
Comment Utility
What is the use of the trayicon for you in that case?

NB : I am writing 8 applications running in the trayicon and watching directories (like your project) ;-)
0
 
LVL 3

Expert Comment

by:SPECIALIST
Comment Utility
I use the tray icon for a very difficult project at work.  The first one:  We have files that get downloaded from the mainframe every month to the lan.  I do not know what the file name is.  but I do know that each file has a specific text in it. it searches the directory for a .rpt file when it finds it, it looks for specific text, (each report has a unique rpt #) imports these into access and formats these reports without intervention.

The second one (just a second timer on the same form) looks for a file that is downloaded from SAS every month imports it into access and updates the database.


Specialist
0
 

Author Comment

by:rhop
Comment Utility
Thank you everyone for youur time, Chack out my new question!!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

763 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now