rhop
asked on
Directory Changed??
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.
to the right and and rename the file using that string.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
let me know if you want me to post it.
Specialist
Specialist,
Is it possible to post it, or send it to me?
thanks
waty.thierry@usa.net
Is it possible to post it, or send it to me?
thanks
waty.thierry@usa.net
ASKER
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
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
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)
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
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"
' '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)
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.
By the way, it is quite the same answer than brunchey.
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
Regards,
Specialist
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) ;-)
NB : I am writing 8 applications running in the trayicon and watching directories (like your project) ;-)
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
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
ASKER
Thank you everyone for youur time, Chack out my new question!!
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(Cou
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
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(errTooManyNotificatio
aerr(errNotificationNotFou
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 = FindFirstChangeNotificatio
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 = FindCloseChangeNotificatio
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
'