Looping Issue with VBA Macro in Excel - excel

I am writing a macro that gets data from two separate locations and pastes it into a template, saves the template as a new file, then loops back and repeats the process. The macro works for one file but fails when looping. Specifically, the computer can't find the file and thinks it has been moved or deleted.
Here is the code:
'sub and dims excluded to save space
'set folder locations
dataFolder = "C:\Location\" 'abbreviated
previousFolder = "C:\Other Location\" 'abbreviated
'set file names
dataFile = Dir(dataFolder & "*.xls*")
previousFile = Dir(previousFolder & "*.xls*")
Do While dataFile <> ""
Set dataWB = Workbooks.Open(dataFolder & dataFile)'this is where the code breaks on looping
'the contents of the loop work fine on the first go so I am excluding them
'Save file to directory
ActiveWorkbook.SaveAs ("C:\Save Location\")
'how I am ending the loop
dataFile = Dir
previousFile = Dir
Loop
End Sub`
I hope this is sufficiently clear. To be even more concise:
dataFile = Dir(dataFolder & "*.xls*")
previousFile = Dir(previousFolder & "*.xls*")
Do While dataFile <> "" 'breaks here after succeeding with first file
'stuff to do
dataFile = Dir
previousFile = Dir
Loop
I was expecting the program to grab the next file in the source folder and repeat the process but instead it breaks saying it can't find the next file (even though it returns the files name in that error message).

If you push the file loop out into a separate function it's easier to deal with multiple file locations:
Sub tester()
Dim files As Collection, filesPrev As Collection
Set files = MatchedFiles("C:\Temp\", "*.xls*")
Set filesPrev = MatchedFiles("C:\Temp\Previous\", "*.xls*")
Debug.Print files.Count, filesPrev.Count
'do something with file names in the collections
End Sub
'Return a collection of file paths
Function MatchedFiles(ByVal fldr As String, pattern As String) As Collection
Dim f
If Right(fldr, 1) <> "\" Then fldr = fldr & "\"
Set MatchedFiles = New Collection
f = Dir(fldr & pattern)
Do While Len(f) > 0
MatchedFiles.Add fldr & f
f = Dir()
Loop
End Function

Related

VBA looping in different order than is displayed in the directory

I'm looping through a directory and grabbing certain files that begin with a certain substring. I would prefer to loop in the order that the files are displayed in the directory, however, when looping and outputting each file name, it iterates to a file not in the next slot of the directory order. Does anyone have an explanation for this? My looping schema is as follows:
'open template file
Set templDoc = Documents.Open(tFile)
strFile = Dir$(strFolder & "16.*.doc") ' can change to .docx
Count = 0
Do Until strFile = ""
Count = Count + 1
Set rng = templDoc.Range
MsgBox strFile
With rng
.Collapse wdCollapseEnd
If Count > 1 Then
.InsertBreak wdSectionBreakNextPage
.End = templDoc.Range.End
.Collapse wdCollapseEnd
End If
.InsertFile strFolder & strFile
End With
strFile = Dir$()
Loop
Directory queue is: 16.2.1, 16.2.3.1, 16.2.3.2...
Looping order is: 16.2.1, 16.2.10, 16.2.11...
Clearly sorts them differently, but is there way to specify looping in "directory order" sort of say?

How to copy data from only the new excel files that are saved in a predefined folder?

I want to copy specific range from excel files stored in a specific folder and paste it in another excel file.I am able to do so.However,every time i run the code it starts with the very first file in the folder.I want to copy data from only the files that haven't been updated before.Is there a way to do that?
EG:
"file1.xlsx" and "file2.xlsx" are in a folder. I want to copy data from the given files and paste it in "NewFile.xlsm" (I'm able to achieve this) However, if I add "file3.xlsx" and "file4.xlsx" in the folder and then run the macro, it copies data from "file1.xlsx" and "file2.xlsx" as well.I want it to copy data only from "file3.xlsx" and "file4.xlsx" this time as the data from previous 2 files is already saved.
(The code i have is given below)
Path = "C:\Users\National\Desktop\TEST Codes\PO\Excel\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
If Filename = "Z master for PO.xlsm" Then
Exit Sub
End If
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Sheets("DETAILED").Range("A3:S15").Copy
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.Close
Dim LASTROW As Long, WS As Worksheet, LS As Long
Set WS = Sheets("sheet1")
LASTROW = WS.Range("R" & Rows.Count).End(xlUp).Row + 1
WS.Range("A" & LASTROW).Select
ActiveSheet.Paste Destination:=WS.Range("A" & LASTROW)
Application.CutCopyMode = False
Filename = Dir()
Loop
Range("A7").Select
One way of doing this is by looking at the DateLastAccessed property, or the DateLastModified property. These are both properties of the File object, see this MS documentation.
You can set a minimum date/time, which should exclude the files you don't want processed.
Be sure to set the correct reference
Option Explicit
Sub GoThroughFiles()
Dim Path As String, Filename As String,
Dim fso, fileinfo
Set fso = CreateObject("Scripting.FileSystemObject")
Path = "C:\Users\National\Desktop\TEST Codes\PO\Excel\"
Filename = Dir(Path & "*.xls")
Set fileinfo = fso.GetFile(Path & Filename)
Do While Len(Filename) > 0
If fileinfo.DateLastAccessed > DateAdd("n", -5, Now) 'If the file was last accessed less than 5 minutes ago
'Do stuff with the file
End If
FileName = Dir()
Loop
End Sub
Furthermore, avoid using Select and Activate as using both will make your code prone to errors. Here is a thread on how to avoid it. Next to that, I added Option Explicit which makes sure you avoid other errors caused by, for example, spelling mistakes.

Excel VBA Dir() Error when file type changes

I'm trying to better understand the Dir function. I have a Dir loop to take action on all .csv files in the directory, but when the loop comes across another file type, like .txt, it will error instead of moving on to the next .csv. item.
This is the relevant portion of my code.
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
strWorkbook = Dir(strSourceExcelLocation & "*.csv*")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
So if there are only .csv files in the directory, then this works fine. When it comes across another file type, an error occurs.
The error is on line
strWorkbook = Dir
Run-time error 5: Invalid procedure call or argument
Am I missing something with the way I use the wildcards in the .csv at the beginning?
Thank you
Solved my issue.
The problem seems to have been because when I called another procedure, I had another Dir in that sub to create a new folder if one didn't already exist. So basically I had a Dir in a Dir, which apparently is bad.
I moved the folder creation part to the very beginning of my procedure, so it is executed before I begin the Dir for looping through all the CSV files.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String, wbktoExport As Workbook, strSourceExcelLocation As String, fldr As String, strTargetPDFLocation As String, d As String
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\"
'***** Creating a folder to save the PDFs in. Naming the folder with today's date *****
d = Format(Date, "mm-dd-yyyy")
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\" & d & "\"
If Len(Dir(strTargetPDFLocation, vbDirectory)) = 0 Then MkDir strTargetPDFLocation
fldr = InputBox("Input the EXACT Folder Name that you want to create PDFs for")
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.csv")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport, strTargetPDFLocation)
'Close Excel workbook without making changes
wbktoExport.Close False
'Get next workbook
strWorkbook = Dir
Loop
End Sub
Try to hardcode the path and give it a try again. Probably the error is something really small in the hardcoding. E.g., in the code below, replace C:\Users\username\Desktop\AAA\ with the path of the file. Then run it. Do not forget the last \. It should work:
Sub TestMe()
Dim workbookPath As String
workbookPath = Dir("C:\Users\username\Desktop\AAA\" & "*.csv")
Do While Len(workbookPath) > 0
Debug.Print workbookPath
workbookPath = Dir
Loop
End Sub

How to loop and open all csv files in my current folder in VBA

I randomly create a new folder on my desktop, in this folder I have one template file with .xlsm extension, which contains my VBA code. Meanwhile I have several csv files saved in the same folder with my raw data.
The purpose is looping through all those csv files one by one, open it, and copy some data and paste to my template file(I know how to do this part) from it and close it after all operations are done.
Currently I meet a problem about how to loop through my folder and open those csv one by one. I didn't set a specific folder name, since I want to share it with other people to use,therefore I use Application.ActiveWorkbook.Path to get the path for my current folder.
Here is my code:
Option Explicit
Sub Range_End_Method()
Dim Dir As String
Dim i As String
Application.ScreenUpdating = False
Dir = Application.ActiveWorkbook.Path & "\"
For Each i In Dir.Files
Debug.Print i.Name
If (i.Name Like "*.csv") Then
Workbooks.Open (i.Path)
End If
Next
End Sub
I'm guessing you want to use the Dir function. To use that, make a call to it, specifying folder and file type in the first call, then call it empty until it returns an empty string. Like this:
Folder = Dir(Application.ActiveWorkbook.Path & "\*.csv")
Do While Folder <> ""
Debug.Print Folder
Workbooks.Open Folder
Folder = Dir()
Loop
You can use this function and macro.
Juste replace MsgBox (myFile + "OK") by the action you want to execute.
FUNCTION
Function ClasseurOuvert(NomFich)
On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open FileName:=NomFich
On Error GoTo 0
End Function
MACRO
Sub LoopFiles()
Dim myPath As String, myFile As String
myPath = Application.ActiveWorkbook.Path & "\"
myFile = Dir(myPath & "\*.*")
Do While myFile <> "" And myFile Like "*.csv"
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)
MsgBox (myFile + "OK")
End With
Workbooks(myFile).Save
Workbooks(myFile).Close
myFile = Dir()
Loop
End Sub

VBA Code to delete Temp files made by word

I have code to delete all files in a folder:
ChDir "C:\test\" 'path
Kill "C:\test*.*" 'type
However, when I open a doc file and save it as a text, it creates a temporary file named ~$*****.doc and these files do not get deleted.
How would I do this?
Sub BatchConvertCSV()
'declarations
Dim i As Integer
Dim j As Integer
Dim NewName As String
Dim objWord As Object
Dim ApplicationFileSearch As New FileSearch
Dim iCnt As Integer
Set objWord = CreateObject("Word.Application")
'search for all.doc files in specified folder
With ApplicationFileSearch
.NewSearch
.LookIn = "C:\test\"
.SearchSubFolders = False
.FileName = "*.doc"
.Execute
j = .FoundFiles.Count
i = 1
MsgBox ("Found files " & j)
'open each document
Do While i < j
Set objWord = Documents.Open(FileName:=.FoundFiles(i))
With ActiveDocument
iCnt = ActiveDocument.Fields.Count
'Somewhere here we need to decide on the placement for an if statement to filter out the doc files for 35 and 39 fields.
'If the doc file does not have that amount of fields
'MsgBox ("Found fields " & iCnt)
If iCnt > 30 And iCnt < 40 Then
.SaveFormsData = True
'save open file as just form data csv file and call it the the vaule of i.txt (i.e 1.txt, 2.txt,...i.txt) and close open file
NewName = i
ChangeFileOpenDirectory "C:\test\Raw Data\"
ActiveDocument.SaveAs FileName:=NewName
objWord.Close False
Else
End If
End With
i = i + 1
Loop
'repeat to the ith .doc file
End With
ChDir "C:\test\" 'path
Kill "C:\test\*.*" 'type
Try this:
With CreateObject("Scripting.FileSystemObject").getfolder("C:\Test")
For Each file In .Files
If Left(file.Name, 2) = "~$" Then
Kill "C:\Test\" & file.Name
End If
Next file
End With
You can, of course, refine that filter as you see fit.
The only problem I can see with that is that you're removing files from .Files while you're looping through them; it might work, but it's probably safer to add each file to a list instead of killing it in the ForEach loop, and then go through and kill everything in the list afterwards.
EDIT:
A little more research. According to this article, you can't use Kill on read-only files. This means you need to use the SetAttr command to remove the "read-only" flag. Here's some code that might help:
Dim strDir, strFile As String
strDir = "C:\Test\" 'Don't forget the trailing backslash
strFile = Dir(strDir & "~$*", vbHidden)
Do Until strFile = ""
If Len(Dir$(strDir & strFile)) > 0 Then
SetAttr strDir & strFile, vbNormal
Kill strDir & strFile
End If
strFile = Dir()
Loop
As you can see, that includes a check that the file actually exists before trying to delete it; as we're pulling that file up with Dir the check shouldn't be necessary, but your experience suggests that extra precautions are needed here. Let me know how that works.

Resources