File not moving VBA - vba

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

Related

Code runs fine but error when stepping through

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.

Find file in sub directory

I need to do a code in VBA to find a file in a subdirectory.
With the code from 'brettdj' in this link I can find the file if I specify the full directory
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("\\A\B\C\D\")
While (file <> "")
If InStr(file, "701000034955") > 0 Then
MsgBox "found " & file
Exit Sub
End If
file = Dir
Wend
End Sub
I'm looking for a why to not to have to specify the full directory.
I tried the code in this link, but I get a 'type mistmatch' error message in the last line
Sub Find_Files()
f = "\\A\B\"
ibox = "701000034955"
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").stdout.readall, vbCrLf)
Sheets("Sheet1").[A1].Resize(UBound(sn) + 1) = Application.Transpose(sn) ' I get an error message in this line
End Sub
Any ideas on why the code above is not working and if there is a better solution to search in subfolders for a file?
your second code differs from the first one in that this latter searches for any file in given folder (and subfolders) whose name is exactly "701000034955" while the former searches for file whose name contains that string
hence I guess you just have to use some wildchars
ibox = "*701000034955*"
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & Application.PathSeparator & ibox & """ /s /a /b").stdout.readall, vbCrLf)
Sheets("Sheet1").[A1].Resize(UBound(sn)) = Application.Transpose(sn)
note the resizing is UBound(sn) instead of UBound(sn) + 1 since there's one endingvbCrlf generating an empty entry in the last position of sn
For the bottom one don't forget to fully qualify the file name with its extension and consider using Path separator to concatenate. For example:
Sub Find_Files()
Dim f As String
f = ThisWorkbook.Path
ibox = "701000034955.xlsb"
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & Application.PathSeparator & ibox & """ /s /a /b").stdout.readall, vbCrLf)
Sheets("Sheet1").[A1].Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

VBA - Do While Loop returns Dir <Invalid procedure call or argument>

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

Publisher VBA to save as image

I've developed the following code to save all publisher files in the current directory as an image, however it seems to take a long time to run through. Also, I can't figure out a way to exclude the current file that the macro is running from. Anyone got any ideas?
Sub Looptest()
Dim MyFile As String, Sep As String
Dim objPub As Object
Set objPub = CreateObject("Publisher.Application")
Dim folder As String
folder = CurDir()
If Len(Dir(folder & "\" & "jpg", vbDirectory)) = 0 Then
MkDir (folder & "\" & "jpg")
End If
Sep = Application.PathSeparator
If Sep = "\" Then
' Windows platform search syntax.
MyFile = Dir(CurDir() & Sep & "*.pub")
Else
MyFile = Dir("", MacID("XLS5"))
End If
' Starts the loop, which will continue until there are no more files
' found.
Do While MyFile <> ""
'If MyFile = "macro.pub" Then
'GoTo ContinueLoop
'End If
Dim pubApp As Publisher.Application
Dim pubDoc As Publisher.Document
Dim folder2 As String
folder2 = CurDir() & Sep & MyFile
Set pubApp = New Publisher.Application
pubApp.Open folder2
'pubApp.ActiveWindow.Visible = True
num = folder2
pubApp.ActiveDocument.Pages(1).SaveAsPicture CurDir() & Sep & "jpg" & "\" & MyFile & ".jpg"
pubApp.Quit
MyFile = Dir()
'ContinueLoop:
Loop
End Sub
I've commented out my attempt at skipping the file (called Macro.pub in this instance), as it just seemed to stall and not go anywhere.
Any help would be greatly appreciated!
-Cr1kk0
Assuming your code is correct in all other respects, this might do the trick
If MyFile = ActiveDocument.FullName Then
GoTo ContinueLoop
End If
I'm guessing your check fails because you're comparing a short file name to a full file name. (You could also just hardcode the entire path to macro.pub)

Why doesn't my file search work?

I'm doing a check to make sure that my code is able to see my file before I move to the next step of my program. This is my code, but it always displays as the path not existing. Did I do something wrong?
Sub NewNameiLoop()
Dim i As Double
Dim NameStr As String
Dim NewNamePath As String
NameStr = Renamer.New_Name.Text
NewNamePath = Renamer.Path_Text.Text & "\" + NameStr & "-" & Right("00" & i, 3) & ".ipt"
Do While i < 99 'Counts with the file name up to -099
i = i + 1
If vbOK Then
MsgBox (Renamer.Path_Text.Text & "\" + NameStr & "-" & Right("00" & i, 3))
If Dir(NewNamePath) <> "" Then
MsgBox "Path Exists."
Else: MsgBox "Path does not exist."
End If
Else: Exit Sub
End If
Loop
End Sub
Other information:
This code is in the module NewNameLoop in the sub NewNameiLoop.
The form it goes to is called Renamer. The form calls NewNameiLoop when the user clicks "Apply" to rename some files. After they are renamed, they call this code to check for the file's existence.
The MsgBox displayed contains the full, correct path.
This is in Autodesk Inventor, not Excel! Thus far, the coding has been pretty much the same. No weird quirks or anything.
JPEGs of what is happening. As explained below, I AM able to access C:\ and things within C:. The first parts of my program make a whole new folder and copy a different folder's contents in to it. After that it goes to the original folder and renames all the files. So does that mean it is indeed a coding problem? No one seems to know.
The Dir will return nothing if:
1) The .ipt file does not exists or the file name is different from what you coded
2) No access to the folder
If you are not concern with the filename I suggest to leave the NewNamepath as Renamer.Path_Text.Text & "\" and do a file search in this path for the file you are looking for
Yes, apparently you can't do a 'Dir' on that folder. But you can use FileSystemObject.
Add a Project reference to "Microsoft Scripting Runtime"
Then adapt the following approach:
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
If oFSO.FileExists(NewNamePath) Then
Debug.Print "Found it"
Else
Debug.Print "Not Found"
End If
Set oFSO = Nothing