Update: I have been directed to a solution here VBA - Do While Loop returns Dir <Invalid procedure call or argument>
The code below is to loop through a folder selected by the user and list the files within.
It works fine when writing to a MsgBox or Debug.Print via F5 but it results in a Run Time Error 5 "Invalid procedure call or argument" when trying to step through it and breaks at FileToList = Dir.
When I observe the watch window for Dir and FileToList, Dir gets to "" before FileToList even gets to the third file in the folder. Every press of F8 moving through the loop causes the Dir value to change before a full loop cycle.
Sub Loop_Inside_Folder()
Dim FileDir As String
Dim FileToList As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.ButtonName = "Pick Folder"
If .Show = 0 Then
MsgBox "Nothing was selected"
Exit Sub
Else
'Folder path
FileDir = .SelectedItems(1) & "\"
End If
End With
'Get first matching file name
FileToList = Dir(FileDir & "*xlsm")
Do Until FileToList = ""
'Debug.Print FileToList
FileToList = Dir
Loop
End Sub
To test it further, I included 5 lines of:
FiletoList = Dir(FileDir & "*.xls*")
FiletoList = Dir(FileDir & "*.xls*")
FiletoList = Dir(FileDir & "*.xls*")
FiletoList = Dir(FileDir & "*.xls*")
FiletoList = Dir(FileDir & "*.xls*")
FiletoList = Dir(FileDir & "*.xls*")
The values at each step were:
Dir : "File 2.xlsx"
FileToList : "File 1.xlsx"
So it would appear that when stepping through, FileToList = Dir isn't working properly. It's as though Dir can't match FileToList and so it goes to the next available file.
I am not sure if it's something with my local enviroment or not? Any ideas?
Many thanks in advance.
Please see update with Stack Overflow link at top of initial post.
Related
I have the following code:
Private Sub cmdExportTERNAME_Click()
On Error Resume Next
Me.MsgFld = "Please wait... exporting TERNAME file."
Dim expLoc As String
Dim xFile As String, myFile As String
Dim myFlag As Integer
expLoc = "I:\Investigative Names\" ' PRD
xFile = Dir(expLoc & "NAME - ForUpload.txt", vbDirectory)
myFile = "NAME-ForUpload.txt"
myFlag = StrComp(xFile, myFile)
If myFlag <> -1 Then
Kill expLoc & "NAME-ForUpload.txt"
End If
' Export text files for upload
DoCmd.TransferText acExportFixed, "SpecTERNAME", "qry_TERNAME", expLoc & "NAME-ForUpload.txt"
xFile = Dir(expLoc & "TNAME-ForUpload.txt")
myFile = "NAME-ForUpload.txt"
myFlag = StrComp(xFile, myFile)
If myFlag <> -1 Then
GoTo ContinueProcessing1
Else
MsgBox "The program was not able to export the NAME file for upload." & Chr(13) & Chr(13) & "Please notify IS Department.", vbCritical, "ERROR MESSAGE BOX"
GoTo exitRTN
End If
ContinueProcessing1:
exitRTN:
End Sub
So I have 2 more of these subroutines with different text files which work fine but this block of code doesn't find xFile, it return a empty string which causes the program to display the message box error. I can't figure out why the same code with different text file works before it reaches this code. The weird thing is it sometimes finds the correct xFile name in debug mode but not when run normally. Can someone help me figure this out?
Thanks
Call MOVEDFFILES("C:\TEMP\MAIN FOLDER\INVOICES\COUNTRY\Invoices\" & SEASON & " DF Invoices\", "C:\TEMP\MAIN FOLDER\INVOICES\COUNTRY\Invoices\" & SEASON & " DF Invoices\Imported\")
I have created the above code to call the below code and move files if they don't exist in the new folder, and delete them in the original folder if they do. however whilst I can use Name OldLocation & MyFile As NewLocation & MyFile to move the files, they dissapear when trying to use the code below. This code works else where for a different file path, the only difference is using *.csv as MyFile, could this cause an issue?
Private Sub MOVEDFFILES(OldLocation As Variant, NewLocation As Variant)
'Makes the file path if not there
If Dir(NewLocation, vbDirectory) = "" Then
MkDir NewLocation
End If
'Moves the files from one location to another
MyFile = Dir(OldLocation & "*.csv")
Do Until MyFile = ""
If Not NewLocation & MyFile > 0 Then
Name OldLocation & MyFile As NewLocation & MyFile
Else
Kill OldLocation & MyFile
End If
MyFile = Dir
Loop
End Sub
The problem is that your check if the file exists in the new location is wrong.
Easiest way to check it would be to issue a Dir-command, but that would break your loop. You can have only one Dir command open, issuing a Dir within the loop to check if the file exists in the new location would cause the command MyFile = Dir fail to check for the next file in the old location.
Turns out that you don't have to do the check at all: Simply issue both, the Name and the Kill command. Trick is to ignore any errors. If the file doesn't exists in the new location, the Name would move it and the Kill doesn't have to delete anything because the file is already gone.. If the file already exists in the new location, the Name will fail and the Kill will do it's job...
So, this is one of the really few situations to use the infamous On Error Resume Next:
f = Dir(OldLocation & "*.csv")
Do Until f = ""
On Error Resume Next
Name OldLocation & f As NewLocation & f
Kill OldLocation & f
On Error GoTo 0
f = Dir
Loop
Can any one help why I can't pickup file from sub-folders?
My code will locate locate and attach the file to an email if the file is in the main folder, but not if the file is located in sub-folders.
Code Sample:
Set obMail = Outlook.CreateItem(olMailItem)
With obMail
.to = "email#comapny.com"
.Subject = "O/S Blanace"
.BodyFormat = olFormatPlain
.Body = "Please see attached files"
iRow = 24 'initialize row index from 24
Do While Cells(iRow, 1) <> Empty
'picking up file name from column A
pFile = Dir(dPath & "\*" & Cells(iRow, 1) & "*")
'checking for file exist in a folder and if its a pdf file
If pFile <> "" And Right(pFile, 3) = "pdf" Then
.Attachments.Add (dPath & "\" & pFile)
End If
'go to next file listed on the A column
iRow = iRow + 1
Loop
.Send
End With
The Dir function doesn't traverse subfolders. It traverses the path you give it, not the tree structure. It also resets when called so calling recursively is not an option.
So if you pass it "C:\Test\" you can use it to traverse Test; if cell contains "C:\Test\NextTest\", you can use it to iterate over NextTest.
What you can do is use a Collection to hold each directory and explore recursively in that way.
For an example of how to do this see the following from How To Traverse Subdirectories with Dir
Sub TraversePath(path As String)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection
currentPath = Dir(path, vbDirectory)
'Explore current directory
Do Until currentPath = vbNullString
Debug.Print currentPath
If Left(currentPath, 1) <> "." And _
(GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
dirCollection.Add currentPath
End If
currentPath = Dir()
Loop
'Explore subsequent directories
For Each directory In dirCollection
Debug.Print "---SubDirectory: " & directory & "---"
TraversePath path & directory & "\"
Next directory
End Sub
Sub Test()
TraversePath "C:\Root\"
End Sub
You can easily adapt this to suit your purposes.
I'm looking for a code to zip the folders of a path specified in my cells(1,1).value
After googling i found vba codes to zip the files of a folder but they are using WinZip.
My office machine does not have a WinZip installed and we are restricted to use WinZip. Could anyone please help with this. I need to use the default zip (Right click -> Send to compressed ZIP folder)
Thanks!
Sub Zip_File_Or_Files()
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long, I As Integer
Dim FName, vArr, FileNameZip
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
'Browse to the file(s), use the Ctrl key to select more files
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(FName) = False Then
'do nothing
Else
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
I = 0
For iCtr = LBound(FName) To UBound(FName)
vArr = Split97(FName(iCtr), "\")
sFName = vArr(UBound(vArr))
If bIsBookOpen(sFName) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close it and try again: " & FName(iCtr)
Else
'Copy the file to the compressed folder
I = I + 1
oApp.Namespace(FileNameZip).CopyHere FName(iCtr)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = I
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
Next iCtr
MsgBox "You find the zipfile here: " & FileNameZip
End If
End Sub
Powered by Ron De Bruin - http://www.rondebruin.nl/win/s7/win001.htm
I have found it helpful to make a couple of tweaks to make this more friendly for the user (which for this sort of thing is often myself).
Limit how long you're willing to wait for the file & message the user if that time limit was reached without success
Add a DoEvents so that you can ctrl+break to pause the code in case you want to inspect (otherwise - can sometimes have to crash Excel, in my experience)
Add a statusbar update so the user knows what's going on
Sub ZipTheFile(ByVal strPath As String, ByVal strFileNameXls As String, ByVal strFileNameZip As String)
'Taken largely from Ron De Bruin - https://www.rondebruin.nl/win/s7/win001.htm
'Create empty Zip File
NewZip (strPath & strFileNameZip)
'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(strPath & strFileNameZip).CopyHere strPath & strFileNameXls
'Keep script waiting until Compressing is done (OR we waited more than 40 seconds...)
On Error Resume Next
i = 0
Do Until oApp.Namespace(strPath & strFileNameZip).Items.Count = 1 Or i > 40 '<-- set how long you're willing to wait here
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents
Application.StatusBar = "Waiting for Zip - counter: " & i
i = i + 1
Loop
On Error GoTo 0
If i > 40 Then MsgBox "there seems to have been a problem putting the file into the zip foder. Check the zip at: " & strPath & strFileNameZip
End Sub
Sub NewZip(sPath) 'You need this sub-routine as well
'Create empty Zip File
'by Ron De Bruin - https://www.rondebruin.nl/win/s7/win001.htm
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
STILL Powered by Ron De Bruin - http://www.rondebruin.nl/win/s7/win001.htm
I am running a loop through a folder in order to get the complete filename address (folders address + file name and extension).
I am using the following, but at some point the Dir value is <Invalid procedure call or argument>
recsFolder = Functions.GetFolder("C:\")
recfile = recsFolder & "\" & Dir(recsFolder & "\*.rec*")
Do While Len(recfile) > 0
recfile = recsFolder & "\" & Dir
Loop
The error is thrown before the loop as completed reading all the files.
EDIT: another approach and Dir is changing everytime I press F8
If Right(recsFolder, 1) <> "\" Then recsFolder = recsFolder & "\"
numFiles = 0
recfile = Dir(recsFolder)
While recfile <> ""
numFiles = numFiles + 1
recfile = Dir()
Wend
I am trying this latest approach and I get the same error. The problem is that when I run the code line by line (F8) I can see that the Dir value changes everytime a new line of code is run inside the While.
Instead of DIR, how about this:
' enable Tools->References, Microsoft Scripting Runtime
Sub Test()
Dim fso As New Scripting.FileSystemObject
Dim fldr As Folder
Set fldr = fso.GetFolder("C:\test")
HandleFolder fldr
End Sub
Sub HandleFolder(fldr As Folder)
Dim f As File
Dim subFldr As Folder
' loop thru files in this folder
For Each f In fldr.Files
Debug.Print f.Path
Next
' loop thru subfolders
For Each subFldr In fldr.SubFolders
HandleFolder subFldr
Next
End Sub
IDK it it helps but this is a pretty solid frame
path = "yourpath" & "\"
Filename = Dir(path & "*.fileextension")
Do While Len(Filename) > 0
'some code
Filename = Dir
Loop