I have an client the writes a file with data every 15 min. The name of the file is the date of that day.
So in the folder I can have for example:
2015-06-01.csv
2015-06-02.csv
2015-06-03.csv
What I want is that is to run a script every 15 minutes or if it’s possible to loop the script to see file changes.
I have been looking around an found one script that might work. But don’t get the copy file to work.
I only want to copy the file that’s been change last.
Option Explicit
Dim fso, path, file, recentDate, recentFile, filePath
Set fso = CreateObject("Scripting.FileSystemObject")
Set recentFile = Nothing
For Each file in fso.GetFolder("C:\CSV\Test\CSVOriginal").Files
If (recentFile is Nothing) Then
Set recentFile = file
ElseIf (file.DateLastModified > recentFile.DateLastModified) Then
Set recentFile = file
End If
Next
If recentFile is Nothing Then
WScript.Echo "no recent files"
Else
WScript.Echo "Recent file is " & recentFile.Name & " " & recentFile.DateLastModified
filePath = fso.GetFile(recentFile.Name)
WScript.Echo "Recent file is " & filepath
fso.CopyFile "C:\CSV\Test\CSVOriginal" +recentFile.Name,"C:\CSV\Test\CSVFlytt\"
End If
Here's one way. Loop through your folder to find the most-recently-modified file:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile, strNewestFile, dtmMax
For Each objFile In objFSO.GetFolder("C:\CSV\Test\CSVOriginal").Files
If objFile.DateLastModified > dtmMax Then
dtmMax = objFile.DateLastModified
strNewestFile = objFile.Path
End If
Next
objFSO.GetFile(strNewestFile).Copy "C:\CSV\Test\CSVFlytt\"
Related
I am looking for a way to copy multiple files from a single folder and copy this grouping of files to multiple folders using FileDialog in Access vba. Below is what I have so far - the problem with this code is that I can only copy multiple files from a single folder to another single folder. Can anyone help with this:
Public Function CopyFilesToFolders()
On Error GoTo Err_Copy
Dim sourcefiles As String
Dim destination As String
Dim source As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a folder that contains the desired files to copy."
If .Show = -1 Then source = .SelectedItems(1)
If Len(source) = 0 Then Exit Function
.AllowMultiSelect = True
.Title = "Select a folder location to copy the files."
If .Show = -1 Then destination = .SelectedItems(1)
If Len(destination) = 0 Then Exit Function
End With
sourcefiles = Dir$(source & "\*.*")
Do While Len(sourcefiles) > 0
FileCopy (source & "\" & sourcefiles), (destination & "\" & sourcefiles)
sourcefiles = Dir$
Loop
Exit_Copy:
Exit Function
Err_Copy:
CopyFilesToFolders = True
MsgBox Error$
Resume Exit_Copy
MsgBox "Task Complete!"
End Function
Thank you,
Al
So you want the function to automatically detect all the subfolders and copy the selected files to them? You can use FileSystemObject to detect all the subfolders, then copy the files to them. See this modified function:
Public Function CopyFilesToFolders()
On Error GoTo Exit_Copy
Dim sourcefiles As String
Dim destination As String
Dim source As String
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a folder that contains the desired files to copy."
If .Show = -1 Then source = .SelectedItems(1)
If Len(source) = 0 Then Exit Function
.AllowMultiSelect = True
.Title = "Select a folder location to copy the files."
If .Show = -1 Then destination = .SelectedItems(1)
If Len(destination) = 0 Then Exit Function
End With
sourcefiles = Dir$(source & "\*.*")
Dim SubFolder
Do While Len(sourcefiles) > 0
For Each SubFolder In FileSystem.GetFolder(destination).SubFolders
FileCopy (source & "\" & sourcefiles), (SubFolder.path & "\" & sourcefiles)
Next
sourcefiles = Dir$
Loop
Exit_Copy:
Exit Function
End Function
Sorry, for changing the topic a bit, but I think int would be a lot easier to do this in Excel, rather than in Access. See the example below.
Sub sbCopyingAFile()
'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
'This is Your File Name which you want to Copy
sFile = "Sample.xls"
'Change to match the source folder path
sSFolder = "C:\Temp\"
'Change to match the destination folder path
sDFolder = "D:\Job\"
'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found", vbInformation, "Not Found"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Sub
Now, if you want to dynamically list the files in a folder, each file path in an individual cell, and then specify exactly which files to copy from one folder to another, that is definitely doable. First, try the sample code above, and give me feedback for future enhancements.
Background:
I receive a daily sales files that I would like to import into access automatically. They are currently saved to a specific folder with a consistent naming convention. I don't review these files everyday and would like to make the import process a push button procedure. There are other files in the folder that I don't need, so I can't just import the entire file.
File Naming Convention: DAILY.SALES.20160611
(the 20160611 is the Year - 2016, Month - June, and Day 11th)
Help needed:
I can import all the files, but I can't figure out how to specify only those files that begin with "Daily.Sales". Below is the code I have that can import everything without specifying. My assumption is that it has something to do with the path or strFile, but none of the variations that I've tried has worked.
It would be nice if the code could actually check if the file has already been uploaded before uploading it, however, if I have to delete the table after each use and re-upload everything that is still easier.
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
DoCmd.SetWarnings False
path = "C:\Desktop\Test\"
Dim objXL As Object
Dim wb As Object
Set objXL = CreateObject("Excel.Application")
strFile = Dir(path & "*.xls")
While strFile <> ""
Set wb = objXL.Workbooks.Open(path & strFile)
If wb.Sheets(1).Range("A1") <> "No Data" And wb.Sheets(1).Range("A1") <> "" Then
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
End If
strFile = Dir()
Debug.Print strFileList(intFile)
wb.Close False
Set wb = Nothing
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Stage", filename, False
Call Format_Staging_Table
Call Copy_from_Stage_to_Master
Call Clear_Staging_Table
Next intFile
DoCmd.SetWarnings True
You can ignore the Call pieces, they are to format the data once I get it in...
Thanks for any help or advice that anyone might be able to provide!
Ok, I just answered a question like this 1 minute ago. I think you should take a look at this link.
http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWktsSepTbl
Just modify that to suit your needs... Basically...change the path and folder to match your file name...
I have a VBA function that creates a FileSystemObject instance, and uses it to read the contents of a directory and perform some stuff based on conditional logic.
In the function, I use a loop that reads the contents of the dir. My question is: What happens when a new file is added to the dir after the loop has been opened but before it is closed? Does the operating system know to include this file in the collection of files? Or is a 'snapshot' of sorts taken of the dir when the loop is opened, causing the newly-added file to be overlooked?
Please correct me on any improper terminology I may have used above.
My code is below:
Function fn_FileCheckType()
'load INI data
fn_ReadINI
'does filename end with .xls or .xlsx?
'read files from iDumpFolder
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim objFolder As Object
Set objFolder = fs.GetFolder(iDumpFolder)
Dim objFile As Object
For Each objFile In objFolder.files
If (objFile.Name Like "*.xls" Or objFile.Name Like "*.xlsx") Then
'do nothing
Debug.Print objFile.Name & " is valid."
Else
'copy to invalid file archive and delete from inbox
objFile.Copy (iInvalidArchive & "\" & objFile.Name)
MsgBox (objFile.Name & " is not saved as .xls or .xlsx. Please modify and re-import.")
objFile.Delete
End If
Next 'objFile
'Cleanup
Set objFolder = Nothing
Set objFile = Nothing
Set fs = Nothing
End Function
The following VBA code indicates that the .Files collection is a "snapshot" of the files in a folder at the moment that the collection is referenced. Before running the code I placed two files in the test folder: b.txt and c.txt. The Debug.Assert statement suspends the code immediately after entering the loop for the first time. While paused, I added the files a.txt and d.txt and then hit F5 to resume execution. The code only lists the two files that were originally in the folder.
Option Compare Database
Option Explicit
Public Sub FilesCollectionTest()
Dim fso As New FileSystemObject, objFolder As Folder, objFile As File, i As Long
Set objFolder = fso.GetFolder("C:\__tmp\zzzTest")
i = 1
For Each objFile In objFolder.Files
Debug.Assert i > 1
Debug.Print objFile.Name
i = i + 1
Next
Set objFile = Nothing
Set objFolder = Nothing
Set fso = Nothing
End Sub
The way you have your example written objFolder.files is re-evaluated on every iteration and would thus pick up any change. But, I was a little surprised to see that if you so something like
Dim fso As New FileSystemObject
Dim files, f
Set files = fso.GetFolder("C:\~\My test Folder").files
For Each f In files
debug.print f.name
Next f
Debug.Print ' break point here
Debug.Print
That even if you are not in the loop Files is refreshed. I put a breakpoint on the firs Print after the loop, added a file to my folder then hit F8, and Files updated to the right file count.
I am creating an MS Access 2010 database. I am using the API to do what the common dialog control did in previous versions of MS Access to open a directory and select a file. My client would like me to be able to open all of the files in the directory when a user clicks on a folder (so the user does not click on a file, just a folder). I cannot find an even triggering when the folder is clicked on within the common dialog control that comes up using the API.
Can anyone tell me how to open all the files in a directory (they will be .pdf files) when using the API for the common dialog control in MS ACCESS 2010?
The API calls I am using are here: http://access.mvps.org/access/api/api0001.htm
Use a FileSystemObject from Microsoft.Scripting.Runtime (must add reference to the project).
The following sub adds to a collection the string names of all pdf files in a given folder.
Get the folder path from the dialog (with folder picking option, not file picking)
Sub GetFolderPDFFiles(FolderPath As String, Col As Collection)
Dim FS As New FileSystemObject
Dim Dir As Folder
Dim Arq As File
Set Dir = FS.GetFolder(FolderPath)
For Each Arq In Dir.Files
If UCase(Right(Arq.Name, 4)) = ".PDF" Then
Call Col.Add(Arq.Path)
End If
Next
End Sub
This worked great for me... it will promt the dialog box to select the folder and open the .pdf files. it will also list all the files in Table1.
Option Compare Database
'function to select the folder where the files are:
Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Enter the routines to open and list the pdf files in the folder (it also look for files in subfolders):
Sub Open_List_Files()
'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objFolder, objTopFolder As Scripting.Folder
Dim strTopFolderName As String, ProjectF As String
Dim i As Long
' call the function to select the folder
Call Módulo1.ChooseFolder
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the top folder
Set objTopFolder = objFSO.GetFolder(ChooseFolder)
'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder, True)
End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Object
Dim objSubFolder As Scripting.Folder
Dim DBStr, filepath As String
'Loop through each file in the folder
For Each objFile In objFolder.Files
On Error Resume Next
If InStr(objFile.Name, ".pdf") Then
DBStr = "INSERT INTO Table1 ([File Name]) " & _
" VALUES (" & _
"'" & objFile.Name & "', " & "');"
CurrentDb.Execute DBStr
'open the file
Application.FollowHyperlink objFile
End If
Next objFile
'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If
End Sub
Run the Open_List_Files() Macro and there you go! :)
I have a large amount of csv files that I need in .xls format. Is it possible to run a batch conversion with a macro or best done with another language?
I have used this code http://www.ozgrid.com/forum/showthread.php?t=71409&p=369573#post369573 to reference my directory but I'm not sure of the command to open each file and save them. Here's what I have:
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim CSVCount As Integer
Dim myVar As String
myVar = FileList("C:\Documents and Settings\alistairw\My Documents\csvxlstest")
For i = LBound(myVar) To UBound(myVar)
With wb
Application.Workbooks.OpenText 'How do I reference the myvar string ?
wb.SaveAs '....
End With
Next
End Sub
Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant
Dim sTemp As String, sHldr As String
If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
sTemp = Dir(fldr & fltr)
If sTemp = "" Then
FileList = Split("No files found", "|") 'ensures an array is returned
Exit Function
End If
Do
sHldr = Dir
If sHldr = "" Then Exit Do
sTemp = sTemp & "|" & sHldr
Loop
FileList = Split(sTemp, "|")
End Function
Edit: The files are .txt files formatted as csv
By combining the code given by Scott Holtzman and 'ExcelFreak', the conversion works quite well. The final code looks something like this:
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "U:\path\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
Opening the converted .xls file throws a warning everytime:
"The file you are trying to open, 'filename', is in a different format than specified by the file extension. Verify that the file is not corrupted and is from a trusted source before opening the file. Do you want to open the file now?"
Clicking Yes then opens the .xls file.
Is there a way to get rid of this warning message? Excel throws a warning everytime the .xls file is opened.
In a lot less lines of code, this should get you what you want. However, I will say this may not be the fastest way to get it done, because you are opening, saving, and closing the workbook every time. I will look for a faster way, but I forget the method off the top of my head.
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
.Close True
End With
Set wb = Nothing
Loop
End Sub
** UPDATE **
you need the proper fileformat enumeration for a .xls file. I think its 50, but you can check here Excel File Type Enumeration, if it's not.
The Code of Scott Holtzman nearly did it for me. I had to make two changes to get it to work:
He forgot to add the line that makes our loop continue with the next file. The last line before the Loop should read
strFile = Dir
The Workbooks.Open method did not read my CSV files as expected (the whole line ended up to be text in the first cell). When I added the parameter Local:=True it worked:
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
This works properly at least on Excel 2013. Using FileFormat:=xlExcel8 parameter instead of the filetype tag 50 creates files that open without security nags.
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\temp\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
This was a good question and I have found in the internet several answers. Just making very small changes (I couldn't edit any of the codes already published) I could make things work a bit better:
Sub CSV_to_XLSX()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\Users\acer\OneDrive\Doctorado\Study 1\data\Retest Bkp\Day 1\Sart\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xlsx"), 51
.Close True
End With
Set wb = Nothing
strFile = Dir
Loop
End Sub