I have some VBA code in excel 2010 that imports multiple .csv files in to one excel workbook however, sometimes there is a rogue file that contains nothing and has a file size of zero that throws up an error, I then have to manually go to the folder and delete this and run my macro again.
Therefore I'm after some help that will allow me to check the file size's of all .csv file contained in a folder and delete any that are zero before I import them. Is there a way I can do this? Or possibly another suggested method that would help?
I'm very new to VBA so please be patient if I don't fully understand straight away.
I have looked into FileLen(C:\Test\test.csv) = 0 Then Kill said file.
But this only deletes specifically the file mentioned. I would rather check all file sizes and if any are zero, kill them.
You can use the FileSystemObject to check files in a folder, and delete them if they are of the correct type and size = 0.
Be very careful running this as the deletions will be permanent (not recoverable).
Option Explicit
'Set reference to Microsoft Scripting Runtime
Sub terfuge()
Dim FSO As FileSystemObject, FI As File, FIs As Files, FO As Folder
Const strBasePath As String = "full_path_of_folder_to_search"
Dim bMsg As Integer
Set FSO = New FileSystemObject
Set FO = FSO.GetFolder(strBasePath)
Set FIs = FO.Files
For Each FI In FIs
If FI.Name Like "*.csv" Then
If FI.Size = 0 Then
bMsg = MsgBox(Prompt:="Are you sure you want to delete " & FI.Name & "?", Buttons:=vbYesNoCancel)
Select Case bMsg
Case vbYes
FI.Delete
Case vbCancel
Exit Sub
End Select
End If
End If
Next FI
End Sub
You can use the DIR command to search through all files in a folder then kill any with a file size of 0.
The code below searches through a specified folder and lists the *.xls filenames in a sheet called Main.
It should be easy to adapt this and combine with your own Kill command.
Sub Directory()
Dim strPath As String
Dim strFolderPath As String
Dim strFileName As String
Dim intRow As Integer
Dim intColumn As Integer
Dim intNumber As Integer
intRow = 1
intColumn = 1
intNumber = 0
strFolderPath = "h:\excel\*.xls" 'search through H drive excel folder
strFileName = Dir(strFolderPath) 'Get name of first file
Do
Sheets("Main").Cells(intRow, intColumn) = strFileName 'write filename
strFileName = Dir 'get next filename
intRow = intRow + 1
Loop Until strFileName = ""
End Sub
Thanks both for your speedy responses, I managed to eventually get my loop going jiggling Andy's sample.
I'd already started dabbling with his idea before Ron responded so continued with it.
I do however like the idea of the user being asked first whether or not they would like to delete the file, so I think I'll have a stab at Ron's suggestion too and maybe learn something along the way.
Thanks again.
Related
I have created an excel application that listed all files in a selected directory (in Excel 2013 32 bit). Following is the script
Const path_col = 1;
Const PDF_File_Col = 2;
Sub input_file(zipFile As String)
Dim source As String
Dim FileCount As Integer
Dim FileName As String
Dim fso
Dim currentPDF As String
Dim currentTXT As String
Dim currentrow As Long
Dim first_Date_Created As String
Dim Cur_Date_Created As String
Dim CurSheet As Worksheet
Set CurSheet = ActiveSheet
source = Replace(zipFile, ".zip", "\")
FileCount = 0
currentrow = Sheets("List").Cells(4, 1).Value
FileName = Dir(source, vbReadOnly)
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Do While FileName <> ""
If Right(FileName, 3) = "pdf" Then
Cur_Date_Created = Format(fso.getfile(source & FileName).datecreated, "yyyy-Mmm-dd")
currentPDF = FileName
With Sheets("List")
.Cells(currentrow, path_col).Value = source
.Cells(currentrow, PDF_File_Col).Value = currentPDF
End With
' read_file source & currentTXT, currentrow
currentrow = currentrow + 1
End If
FileName = Dir()
Loop
Application.ScreenUpdating = True
Exit Sub
Issues
The script have been running daily since few years ago under Windows 7 without any issue until moving the Windows 10 a few months ago. After moving into Windows 10 we start finding it failed to list all pdf files (ie. stopped in the middle so how) intermittently without any error message populated (Note: we have not dismissed any error message before running this subroutine.)
The PDF files inside the folder was named by consecutive number and always end with ".pdf" (always in lower case). For Example: If the folder have 1200 PDF file, it will then be in arange as "PDF0001.pdf", "PDF0002.pdf" - "PDF1200.pdf". However, for some reason the sub-routine may stop running at "PDF0900.pdf"and the rest ("PDF0901.pdf - "PDF1200.pdf") will be missed from the list. However, it mayworks fine if we simply rerun the subroutine.
Note
User selected the zip file. However, it was already unzipped before
enter to this subroutine The folder only have pdf files. But usually
have more than 1000 to 5xxx and the total folder size can be upto 500MB
Could you please share me some light on what should I do regarding to this problem?
Thanks in advance!
The folder does not have only pdf files, since the folder path is extracted from a Zip one, but this is not an issue since the retrieved files by Dir are filtered according to their extension.
If you move the first Dir after source = Replace(zipFile, ".zip", "\") it will be better. Only in this way the folder path is a correct one.
Try transforming it in fileName = Dir(source & "*.pdf"). In this way, it will return only the pdf files in the directory and you can comment the line If Right(FileName, 3) = "pdf" Then, not being necessary, anymore.
Dir does not belong to FileSystemObject.
I (only) suppose that not Dir is 'guilty'. It correctly retrieves all files until the code crushes. Try using DoEvents after the line FileName = Dir(). And maybe after, too...
I have a little problem with my code in VBA, How can I exclude the other extension file like .txt, .csv, .xlsx, and .xlsm so I can select only in my For Each Loop is the .PDF extension only.
I've already searched about this issue and already tried, But the solution is not applicable in my code.
This is my code:
Option Explicit
Sub GetPDFFile()
Dim mainWs As Worksheet
Dim pdfPath As Variant, excelPath As Variant
Dim fileSystemObject As New fileSystemObject
Dim getFolderPath As Folder
Dim getFile As file
Dim wb As Workbook
Set mainWs = ThisWorkbook.Sheets("Main")
pdfPath = mainWs.Range("C7").Value
excelPath = mainWs.Range("C8").Value
'Set all variable to null
Call SetNothing
If pdfPath = "" Then
Call MsgActionInvalid("Please input PDF File Folder.")
ElseIf excelPath = "" Then
Call MsgActionInvalid("Please input Output Folder Location.")
Else
Set getFolderPath = fileSystemObject.getFolder(pdfPath)
Set wa = CreateObject("word.application")
If cntFiles <> 0 Then
For Each getFile In getFolderPath.Files
`Other code............
Next
End Sub
I'm getting all the files inside the folder that I've selected. So inside the For Each Loop I'm getting a debug message because the file is not .PDF.
Any ideas about this guys?
Thanks in advance.
Use the Type property of the File object like getFile.Type to find out its type. And use a If statement to run your Other code............ only on the desired type of files.
Alternatively use UCase(getFile) Like "*.PDF" to make sure that it is not case sensitive. Otherwise you only trigger .PDF but not .Pdf or .pdf or .pDf or whatever.
Which is the same as UCase(Right$(getFile, 4)) = ".PDF"
You should be using Right to check the file extension. Something like:
For Each getFile In getFolderPath.Files
If Right(getFile, 4) = ".pdf" Then
' have found a PDF extension............
End If
Next
Regards,
I want to create a macro that can check and open file based on filename.
ex:
15.xlsm As opened workbook
12.xlsm As a target
16.xlsm As the future workbook
So while I click a button in 15.xlsm that will open the previous file (12.xlsm). But in future, when the 16.xlsm is created, the 16.xlsm must open the previous workbook (15.xlsm).
I was trying with this code
Sub Macro1()
Dim a, x As Integer
Dim path, filename As String
Dim varday, varyest As Long
varday = Day(Range("A1"))
For x = 1 To 30
varyest = varday - x
filename = "" & varyest & ".xlsm"
path = "F:\Kemal\" & filename & ""
If Dir(path) = "" Then
Else
Workbooks.Open filename:=path
End If
Next x
End Sub
but that code has open all workbook like 12.xlsm, 10.xlsm, 9.xlsm, and create unlimited messagebox. Yeah I know the algorithm but, how to put it into code is the big problem. anyone help me, pls.
So, How to check previous file is exist or not with date that placed on every workbook name?
to know if file exists :
CreateObject("Scripting.FileSystemObject").FileExists(p)
If you want to check MANY files, you may want to use the content of the whole folder and lookup the array.
if target workbooks has a Workbook_Open that's not to be launched:
Application.EnableEvents = False
workbooks.open(file)
Application.EnableEvents = true
Question is a bit fuzzy to me, I hope this answers
This question already has answers here:
Get list of sub-directories in VBA
(5 answers)
Closed 8 years ago.
I understand that the answer to this question may be similar to another, but the question is posed in a different way. This question is based on the fact that the user, me, did not know FileSearch was removed. The other is conceptually based, and contains prior knowledge of excel's 2010 changes...
I have found some code here
Sub Search()
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objSearch = objExcel.FileSearch
objSearch.Lookin = "D:\Music"
objSearch.SearchSubfolders = TRUE
objSearch.FileName = "*.wma"
objSearch.Execute
For Each strFile in objSearch.FoundFiles
Wscript.Echo strFile
Next
objExcel.Quit
End Sub
I tried to run that code on my machine, with it adapted to one of my folders and an extention within the folder, but it returned an error 445 (object doesn't support this action). I'm using excel 2010.
Does anyone know what's going on? I'm trying to help out a co-worker, but I don't know much about File I/O beyond the simple stuff in VBA.
FileSearch was removed from VBA in Office 2007. Thankfully it's not difficult to create your own routine for searching files using the FileSystemObject (add the Windows Scripting Runtime as a reference to get Intellisense code hints).
This is the one that I use - your list of files will be returned as a Collection by the FileList function. It should be simple to add a filter to this to only populate the collection with files of a particular extension.
[Note that you'll need to add the Windows Scripting Runtime reference as mentioned above since the objects are early bound in my example]
Function FileList(Path As String) As Collection
Dim FSO as New Scripting.FileSystemObject
Dim StartingFolder As Scripting.Folder
Set StartingFolder = FSO.GetFolder(Path)
Set FileList = New Collection
RecursiveGetFiles StartingFolder, FileList
End Function
Private Sub RecursiveGetFiles(StartingFolder As Scripting.Folder, ByRef FullFileList As Collection)
Dim File As Scripting.File
For Each File In StartingFolder.Files
FullFileList.Add File, File.Path
Next File
Dim SubFolder As Scripting.Folder
For Each SubFolder In StartingFolder.SubFolders
RecursiveGetFiles SubFolder, FullFileList
Next SubFolder
End Function
This code can then be called by some parent routine, i.e.
Sub Search(Path As String)
Dim ListOfFiles As Collection
Set ListOfFiles = FileList(Path)
Dim File As Scripting.File
For Each File In ListOfFiles
Debug.Print File.Name
Next File
End Sub
Sub Search()
Dim StrFile As String, Path As String, FileName As String
Path = "D:\Music"
FileName = "*.wma"
StrFile = Dir(Path & FileName)
Do While Len(StrFile) > 0
Msgbox StrFile
StrFile = Dir
Loop
End Sub
We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file.
EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*"
EDIT
The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function:
Function OpenWorkbook(strPath As String) As Workbook
On Error GoTo ErrorLabel
Set OpenWorkbook = Workbooks.Open(strPath)
ExitLabel:
Exit Function
ErrorLabel:
If Err.Number = 1004 Then
Resume ExitLabel
Else
'other error handling code here
Resume ExitLabel
End If
End Function
Then you can consume the function like this:
Dim w As Workbook
Set w = OpenWorkbook(file.Path)
If Not (w Is Nothing) Then
'...
The problem you're having has to do with this line:
If file.Type = "Microsoft Excel Worksheet" Then
Try adding and replacing it with this:
// add these lines just AFTER the line 'For Each file In files'
IsXLFile = False
FilePath = file.path
FilePath2 = Right(FilePath, 5)
FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1)
If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True
// replace faulty line with this line
If IsXLFile = True Then
Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not.
Have a nice day.