I want to change this to the SFTP server. How should I update this following script?
'FTP Upload
'Upload a file/folder to an FTP server
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFSO
Varnow = now
vardate = Day(varnow) & "-" & Month(varnow) & "-" & Year(varnow) & ".csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFile = "D:/file.csv"
strRename = "D:/file-" & vardate
If objFSO.FileExists(strFile) Then
objFSO.MoveFile strFile, strRename
End If
'Path to file or folder to upload
path = strRename
FTPUpload(path)
Sub FTPUpload(path)
On Error Resume Next
'Copy Options: 16 = Yes to All
Const copyType = 16
'FTP Wait Time in ms
waitTime = 8000
FTPUser = "ftuser"
FTPPass = "psw"
FTPHost = "hostname"
FTPDir = "/Dir"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "#" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)
'Upload single file
If objFSO.FileExists(path) Then
Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
objFTP.CopyHere objItem,copyType
End If
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If
'Wait for upload
WScript.Sleep waitTime
If objFSO.FileExists(strRename) Then
objFSO.MoveFile strRename, strFile
End If
End Sub
So as you see I want to switch the FTP upload to SFTP upload (because the destination server have been changed to the SFTP protocol. What should be modified exactly in the this function Sub FTPUpload(path) to do so?
Have you any tips to do so?
There's no support for SFTP in FileSystemObject, nor any other way in Windows.
You have to use a 3rd party SFTP command-line client or COM object.
So there's no easy way to change your existing script. You have to basically start from the scratch.
There are lot of existing questions on Stack Overflow for SFTP uploads with VBScript.
You can for example use WinSCP SFTP client. It has both command-line scripting interface and COM object.
Using WinSCP scripting in Windows Scripting host (JScript or VBScript)
Does not require any installation, but it's more difficult to use from VBS.
Using WinSCP .NET assembly/COIM library in Windows Scripting host (JScript or VBScript)
Requires installation (registration), but it's easier to use from VBS.
(I'm the author of WinSCP)
Related
I made a script that copying a file to a certain location.
I add the .vbs to taskschd.msc scheduled for make a .pst backup
but I get error message
Line: 91
Char: 7
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
<pre>
'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de#teknotrans.se.pst"
pst(1) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de.pst"
'Define your backup location
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
'Keep old backups? TRUE/FALSE
KeepHistory = FALSE
'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
start = TRUE
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(delay)
'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)
'Open Outlook again when desired.
If start = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(delay)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each Process in objWMIService.InstancesOf("Win32_Process")
If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
set colProcessList = Nothing
End Sub
Sub BackupPST(pst, BackupPath, KeepHistory)
Set fso = CreateObject("Scripting.FileSystemObject")
If KeepHistory = True Then
ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
BackupPath = BackupPath & ArchiveFolder & "\"
End If
If fso.FolderExists(BackupPath) = False Then
fso.CreateFolder BackupPath
End If
For Each pstPath in pst
If fso.FileExists(pstPath) Then
fso.CopyFile pstPath, BackupPath, True
End If
Next
Set fso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
</pre>
Could someone help me to solve this?
Thank you in advance
Seems like you schedule the script.
You need to start the task with a user that executes the script which has rights on the PST file, as well as on the path where you store the backup. Running it with the system account won't be enough.
There are better ways to backup PST files also, I use a Ruby script to synchronise a local copy with a backup copy, is runs on PST's more than 10GB big without problem, might be a problem if you would do it with a copy like this.
You need to backup the copy on a backup medium also because when the PST has errors (and all big PST have) you copy the errors to the backup and could lose both.
Also, you do the following
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
...
BackupPath = BackupPath & ArchiveFolder & "\"
Where is the \ between the two first variables ?
EDITED: Change the permissions of the folder.
In windows explorer, navigate to the folder where the PST file is located.
In the left pane of windows explorer, right click on the folder where the PST file is located, select "Properties".
Select the "Security" tab
Click the button "Edit" to change permissions.
Click "Add"
In the object names to select box, enter "everyone" (no quotes).
Click "Check Names", everyone should become capitalized and underlined.
Click "Ok"
Select "Everyone" from the list of Groups or user names.
In the "Permissions for Everyone" list, make sure "Read & Execute, List folder contents and Read, in the allow column are checked, click "Apply"
Click Ok.
NOTE: By doing this, anyone who has access to this computer can access the folder. You might consider only adding your login to the computer to the list of Groups or usernames instead of Everyone. You may have to repeat the above steps on the PST file(s) in question.
Original Post:
I ran the script here, testing for various issues and it ran without problems. At this point I believe the issue is rights and permissions to either the source or destination folder (or the files you are backing up). By default, the user's themselves don't have access to Outlooks data files. You would need to add "read" permissions to the files in question (PST,OST, and so on) or the full folder.
In reality, just backing up the PST files isn't enough to restore an Outlook configuration; you would need all of the files.
You can Try this:
'===================================================================
'Description: VBS script to backup your pst-files.
'
'Comment: Before executing the vbs-file, set the location of outlook
' folder you want to backup and
' the backup location (this can also be a network path).
' See the URL below for more configuration instructions and
' how to create a Scheduled Task for it.
'
' Original author : Robert Sparnaaij
' Modified: Fred Kerber
' version: 1.1
' website: http://www.howto-outlook.com/downloads/backupscript.htm
' Changes:
' Changed var types; changed to backup full folder and not just pst files.
'===================================================================
'===================BEGIN MODIFY====================================
'Define the folder location of Outlook's data files.
sOutlookDataPath = "C:\Users\FKerber.CORP\AppData\Local\Microsoft\Outlook\"
'Define your backup location
sBackupPath = "E:\Outlook Backup\"
'Keep old backups? TRUE/FALSE
bKeepHistory = TRUE
'Maximum time in milliseconds for Outlook to close on its own
iDelay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
bStart = True
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(iDelay)
'Outlook is closed, so we can start the backup
Call BackupOutlook(sOutlookDataPath, sBackupPath, bKeepHistory)
'Open Outlook again when desired.
If bStart = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(iDelay)
Set objWMIService = GetObject("winmgmts:" &_
{impersonationLevel= impersonate}!\\.\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each oProcess in objWMIService.InstancesOf("Win32_Process")
If StrComp(oProcess.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Sub
Sub BackupOutlook(sOutlook, sBackupPath, bKeepHistory)
Set ofso = CreateObject("Scripting.FileSystemObject")
If bKeepHistory = True Then
sArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
sBackupPath = sBackupPath & sArchiveFolder & "\"
Else
For Each oFile In ofso.GetFolder(sBackupPath).Files
ofso.DeleteFile oFile.Path, True
Next
End If
If ofso.FolderExists(sBackupPath) = False Then
ofso.CreateFolder sBackupPath
End If
For Each oFile In ofso.GetFolder(sOutlook).Files
If ofso.FileExists(oFile.Path) Then
ofso.CopyFile oFile.Path, sBackupPath, True
End If
Next
Set ofso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
I had a similar problem trying to delete files with VBS. I assume that as with my case: The source of the problem is that the script is trying to perform some operation on a file or folder that has a Read-only Attribute. To solve this manually you could left click -> properties -> unclick the Read-Only Attribute then the file/folder should be copied by the script. To solve the problem with VBS: I make the assumption that file/folder is set to Read-Only because there is a programme currently using them.
One: we can just skip files/folders set to read-only this time and hope to get them next time the script runs. For this we first check if file/folder is read-only (I got this from here: https://social.technet.microsoft.com/Forums/ie/en-US/7382d452-1ef9-404a-8874-48d38fcfe911/vbscript-verify-if-a-file-is-readonly?forum=ITCG), if not then we perform the copy operation.
Sub BackupPST(pst, BackupPath, KeepHistory)
'........
For Each pstPath in pst
If fso.FileExists(pstPath) Then
If not (fso.GetFile(pstPath).Attributes AND 1) Then 'if item is not read-only
fso.CopyFile pstPath, BackupPath, True
End If
End If
Next
Set fso = Nothing
End SubSub
Two: At the very least this should prevent you from getting the error. But if the script never moves the files even after running a number of times then chances are that the files (you are trying to move) are always in read only and you should change Attribute of the file (you are trying to move) in your script before calling the copy function, see how to do that here: https://devblogs.microsoft.com/scripting/how-can-i-change-a-read-only-file-to-a-read-write-file/
currently i have an Email that comes in and my vba code will save the file to a folder, however since this code was made they now send me the file in a zip file. This of course breaks the code and i have to resend it in a non zip file to make it work. Here is a sample of what I am currently using:
If Left(objItem.Subject, 28) = "xxxxx report Toolbox" Then
For Each Atmt In objItem.Attachments
FileName = "O:\Automated Reports\toolbox.xlsx"
Atmt.SaveAsFile FileName
modify_file
Debug.Print "success CSAT file"
Open "O:\Automated Reports\toolboxDate.JW" For Output As #1
Write #1, Right(objItem.Subject, 5)
Close #1
Next Atmt
End If
As i stated before this code woks fine for just saving the file when it is not a .zip file. I need it to unzip the file and save it to the O: drive. I have tried to use some shell.application objects but i didn't quite get that to work. Thanks for any help ahead of time
'Create new blank zip.
Set Ag=Wscript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Ag(0), 8, vbtrue)
BlankZip = "PK" & Chr(5) & Chr(6)
For x = 0 to 17
BlankZip = BlankZip & Chr(0)
Next
ts.Write BlankZip
'Unzip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set SrcFldr=objShell.NameSpace(Ag(1))
Set DestFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
'Zip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set DestFldr=objShell.NameSpace(Ag(1))
Set SrcFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
At present I am opening a file with my vbscript as follows:
strFile = "C:\Users\test\file.txt"
Set objFile = objFSO.OpenTextFile(strFile)
I would like to change this so that a file can be selected/navigated to by the user and that file is used in the script. How can I add this ability? I have tried to search for how to load a file dialog/prompt the user for a file etc just not sure how to complete in a VBScript.
There is another solution I found interesting from MS TechNet less customization but gets what you wanted to achieve. This returns the full path of the selected file.
Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
sFileSelected = oExec.StdOut.ReadLine
wscript.echo sFileSelected
Here you go:
http://www.robvanderwoude.com/vbstech_ui_fileopen.php
strFile = GetFileName("C:\Users\test\", "Text files|*.txt")
Set objFile = objFSO.OpenTextFile(strFile)
Function GetFileName( myDir, myFilter )
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDialog
' Create a dialog object
Set objDialog = CreateObject( "UserAccounts.CommonDialog" )
' Check arguments and use defaults when necessary
If myDir = "" Then
' Default initial folder is "My Documents"
objDialog.InitialDir = CreateObject( "WScript.Shell" ).SpecialFolders( "MyDocuments" )
Else
' Use the specified initial folder
objDialog.InitialDir = myDir
End If
If myFilter = "" Then
' Default file filter is "All files"
objDialog.Filter = "All files|*.*"
Else
' Use the specified file filter
objDialog.Filter = myFilter
End If
' Open the dialog and return the selected file name
If objDialog.ShowOpen Then
GetFileName = objDialog.FileName
Else
GetFileName = ""
End If
End Function
The currently chosen answer doesn't support filters, but hta can be manipulated to support them.
Here's an answer based on this tek-tips.com post (which is also mentioned in
How to add filter to a file chooser in batch?), but I added a full function structure plus support for relative folders:
Function GetFileDlgEx(sIniDir,sFilter)
sTitle = "Choose File"
set objShell = WScript.CreateObject("WScript.Shell")
if instr(sIniDir, ":") <= 0 then
sIniDir = objShell.CurrentDirectory & "\" & sIniDir
end if
sIniDir = Replace(sIniDir,"\","\\")
Set oDlg = objShell.Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
sIniDir = "*.*pdf" ' will look in current folder - note extension must be preceded by an asterisk *.
'sIniDir = "docs\*.*pdf" ' will look in a relative folder
'sIniDir = "C:\Windows\*.*pdf" ' will look in an absolute folder
sFilter = "Adobe pdf (*.pdf)|*.pdf|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Image files (*.gif;*.png;*jpg;*.bmp)|*.gif;*.png;*jpg;*.bmp|Html files (*.htm;*.html;*.mht)|*.htm;*.html;*.mht|"
rep = GetFileDlgEx(sIniDir,sFilter)
MsgBox rep
VBSEdit program installs a COM library VBSEdit Toolkit, which allows Open File dialogs.
From VBSEdit help:
Dialog boxes
OpenFileDialog method
Prompt the user to open a file
toolkit.OpenFileDialog ([initialFolder,[filters,[multiselect,[title]]]])
'Opens a single file
Set toolkit = CreateObject("VbsEdit.Toolkit")
files=toolkit.OpenFileDialog("c:\scripts\","Text Files (*.txt)|*.txt",False,"Open a text file")
If UBound(files)>=0 Then
WScript.Echo files(0)
Else
Wscript.Quit
End If
'Opens multiple files
Set toolkit = CreateObject("VbsEdit.Toolkit")
files=toolkit.OpenFileDialog("c:\scripts\","Text Files (*.txt)|*.txt",True,"Open a text file")
If UBound(files)>=0 Then
For Each filepath In files
WScript.Echo filepath
Next
Else
Wscript.Quit
End If
SaveFileDialog method
Prompt the user to save a file
toolkit.SaveFileDialog ([initialFolder,[initialFilename,[filters,[title]]]])
Set toolkit = CreateObject("VbsEdit.Toolkit")
filepath = toolkit.SaveFileDialog("c:\scripts","test.txt","Text Files (*.txt)|*.txt")
If Not(IsNull(filepath)) Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(filepath,True)
objFile.WriteLine Date
objFile.Close
Else
Wscript.Quit
End If
SelectFolder method
Prompt the user to select a folder
toolkit.SelectFolder ([initialDir,[title]])
Set toolkit = CreateObject("VbsEdit.Toolkit")
myfolder=toolkit.SelectFolder("c:\scripts\","Please select a folder")
If Not(IsNull(myfolder)) Then
WScript.Echo myfolder
Else
Wscript.Quit
End If
…
(Actually, folder selection dialogs can be opened without VBSEdit toolkit, with BrowseForFolder method of Shell.Application object.)
Found this answer HERE
Set WshShell=CreateObject("Wscript.Shell")
WshShell.BrowseForFolder(0, "Please select the folder.", 1, "")
I am trying to ping a server before uploading a file with ftp. Recently, a client complained that the process was freezing. I tested the ping process with a vbscript file just to make sure something wasn't broken on the computer. The vbscript worked just fine. So I ran the script from the Access database and it hung just the same as it did before. Is there something about the ping exe that I am missing here?
Vbscript that runs just fine when you double click it.
Const fsoForWriting = 2
Dim oShell, ping, strPath, strPing
Set oShell = WScript.CreateObject ("WScript.Shell")
Set ping = oShell.exec("ping -n 2 -w 750 google.com")
Do While ping.Status = 0
WScript.Sleep 100
Loop
strPing = ping.StdOut.ReadAll
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = objFSO.GetParentFolderName(strPath) & "\PingResults.txt"
Set objTextStream = objFSO.OpenTextFile(strTextFile, fsoForWriting, True)
objTextStream.WriteLine strPing
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Set oShell = Nothing
VBA function that runs on the test database on startup. This is the code that hangs.
Function fFtpOnline(ByVal ComputerName As String)
On Error GoTo ErrHandler
Dim oShell, ping
Set oShell = CreateObject("WScript.Shell")
Set ping = oShell.exec("cscript " & Access.CurrentProject.Path & "\" & "Test.vbs")
Do While ping.Status = 0
DoEvents
Loop
Set oShell = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description & " " & "fFtpOnline "
Resume Next
End Function
This code works fine on my computer but on the client's computer, the code hangs.
This may sound like a rude answer, but by no means is it intended to be. Just as the comment above stated, this is more than likely it issue on your customer's end. If the program works currently on your end and not theirs they have the issue, not the code. I've run into plenty of customers who are clueless so unless they are willing to let you take control of their machine remotely I would recommend them capturing some information for you. ipconfig is a good place to start. And while they are at the command prompt have them try to ping some places. I know this is not a true answer, but it is what I have encountered in the past.
I am writing a program that integrates with a ScanSnap scanner. ScanSnap scanners do not support TWAIN. Once a document is scanned it is automatically saved to a PDF.
I want to monitor the directory where the files will be saved and take some action when the file appears (and is done being written to). A simple approach is to use the MS Access form Timer event and check for an existing file at some small interval of time.
Is there a better alternative via Windows Messaging, the FileSystemObject, or some Windows API function that supports callbacks?
This provides a native WinAP + VB/VBA way of doing the job, I expect:
http://books.google.com/books?id=46toCUvklIQC&pg=PA757&lpg=PA757&dq=windows+api+monitor+directory+changes+vba&source=bl&ots=jmMY4sJFK4&sig=KCB6B_soEA9_JzjlhyNZvSC91w4&hl=en&sa=X&ei=cUAMUsDzOe3iyAHu8YGwAg&ved=0CFIQ6AEwBw#v=onepage&q=windows%20api%20monitor%20directory%20changes%20vba&f=false
Nothing inside Excel.
You can create another application that monitors the file system, and executes the Excel macro, opening the workbook if required, opening Excel if required.
#Steve effectively answered the question I asked. What I should have asked is how to monitor file system changes in a thread separate from the MS Access UI thread. And the simple answer to that question is that VBA does not support multi-threading in Office applications.
There are a variety of workarounds that generally involve calling an external COM library or integrating with an external application. I decided none of those was very appealing and instead decided to implement the solution in VB.Net using the FileSystemWatcher class.
Not sure if this really solves your Problem, but here is an approach using Excel VBA that helped me monitor a specific file within a specific Folder and execute certain actions (here: copy the file into another folder) if the file is modified and saved (i.e. when the file's timestamp changes):
Option Explicit
Const SourcePath = "C:\YourFolder\"
Const TargetPath = "C:\YourFolder\YourFolder_Changes\"
Const TargetFile = "YourFileName"
Private m_blnLooping As Boolean
Private Sub CommandButton1_Click()
Dim FSO As Scripting.FileSystemObject
Dim n, msg, dt, inttext As String
Dim file, files As Object
Dim d1, d2 As Date
Dim cnt As Integer
Dim wsshell
Application.ScreenUpdating = False
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set files = FSO.GetFolder(SourcePath).files
Set wsshell = CreateObject("WScript.Shell")
msg = "FileWatcher started. Monitoring of " & TargetFile & " in progress."
cnt = 0
'Initialize: Loop through Folder content and get file date
For Each file In files
n = file.name
'Get Initial SaveDate of Target File
If n = TargetFile Then
d1 = file.DateLastModified
End If
Next file
m_blnLooping = True
inttext = wsshell.popup(msg, 2, "FileWatcher Ready", vbInformation)
'Message Box should close after 2 seconds automatically
Shell "C:\WINDOWS\explorer.exe """ & TargetPath & "", vbNormalFocus
'Open Windows Explorer and display Target Directory to see changes
Do While m_blnLooping
For Each file In files
n = file.name
If n = TargetFile Then
d2 = file.DateLastModified
If d2 > d1 Then
dt = Format(CStr(Now), "yyyy-mm-dd_hh-mm-ss")
'FSO.CopyFile (SourcePath & TargetFile), (TargetPath & Left(TargetFile, Len(TargetFile) - 4) & "_" & dt & ".txt"), True 'Option with file name extension
FSO.CopyFile (SourcePath & TargetFile), (TargetPath & TargetFile & "_" & dt), True 'Option without file name extension
cnt = cnt + 1
d1 = d2
End If
End If
Next file
'Application.Wait (Now() + CDate("00:00:02")) 'wait 2 seconds, then loop again
DoEvents
Loop
msg = "File " & TargetFile & " has been updated " & cnt & " times."
inttext = wsshell.popup(msg, 2, "FileWatcher Closed", vbInformation)
'Message Box should close after 2 seconds automatically
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
m_blnLooping = False
End Sub
The procedure is activated via a CommandButton ("START") and loops through the speficied Folder (keeps watching the file) until another CommandButton ("STOP") is pressed. You may, however, need to adjust the code to monitor file creation instead of file changes (file.DateCreated instead of file.DateLastModified). The Code is just meant to provide you hint that might solve your Problem.