I'm trying to loop through all files in a given directory using VBA and replace a few words in each file before saving it in another directory. The method I'm using is:
With Application
Do While Len(fileName) > 0
Where fileName is:
fileName = Dir$("C:\FOLDER\" & "*")
After I run the code I have:
fileName = Dir
Loop
However, after it goes back to the top of the loop, it does not pick up any more files. I am sure there are multiple files in the given directory.. Any ideas?
Test it in separate Subs, this two codes works.
Sub LoopAllFiles()
Dim StrFile As String
StrFile = Dir$("C:\FOLDER\" & "*")
Do While Len(StrFile) > 0
StrFile = Dir
Loop
End Sub
Sub LoopAllFiles()
Dim StrFile As String
StrFile = Dir("C:\FOLDER\" & "*")
Do While StrFile <> ""
StrFile = Dir
Loop
End Sub
Related
I am trying to open file from the same folder as the main workbook. The problem is that the name is not permanent and just one word stays always inside the name - "NAME".
I want to use specific method with Thisworkbook.Path to open the xlsx file but it is not finding the workbook with the code.
that is the relavant part of code:
Sub RemoveDuplicats()
Dim Harel As Workbook
Dim SAP As Workbook
Dim Path As String
Dim Found As String
Path = ThisWorkbook.Path
Found = Dir(Path & "*NAME*.xlsx") 'open SAP report
If Found <> "" Then
Set SAP = Workbooks.Open(Path & Found)
End If
End Sub
ThisWorkbook.Path Returns the path without trailing backslash,
try
Found = Dir ( Path & "\" & "*NAME*.xlsx")
You would need to Loop though all Fiels in this Folder and compare the File Names like this:
Dim StrFile As String
StrFile = Dir(ThisWorkbook.Path & "\*" & ".xlsm")
Do While Len(StrFile) > 0
If StrFile Like "*Name*" Then
MsgBox StrFile 'This will be your File
End If
StrFile = Dir
Loop
I am naive to scripts, and I started working with Excel macros. I am looking for a macro to rename only the file extension from *.xml to *.qml. The *.xml file is in the same workbook path. So, I appreciate if anyone could help in this.
Try following code:
Sub RenameFiles()
Dim StrFile As String, newName As String
Dim filePath As Variant
filePath = ActiveWorkbook.Path & "\"
StrFile = Dir(filePath & "*.xml")
Do While Len(StrFile) > 0
newName = Replace(StrFile, ".xml", ".qml")
Name filePath & StrFile As filePath & newName
StrFile = Dir
Loop
End Sub
NOTE: Code will rename all .xml files to .qml so its better to take the back up before executing the code.
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
I found this thread with the same issue as mine, but I've copied the code into my project, and it doesn't seem to work.
VBA macro: replace text in word file in all sub folders
I was stepping through the code, and it gets to line 32 (under the For Each varItem in colSubFolders) but then it skips right over the find/replace section to the end of the code. Is the problem in my file format?
EDIT: Additionally, when I get to varitem in ln 31, the value of "varitem" is the name of the folder, not the names of the word documents in the folder: I think this is where the issue is.
Sub DoLangesNow()
Dim file
Dim path As String
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
' Parent folder including trailing backslash
'YOU MUST EDIT THIS.
strFolder = "L:\Admin\Corporate Books\2015\2014 Consents macro\company Annual Consents"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
' Loop through word docs in subfolder
'YOU MUST EDIT THIS if you want to change the files extension
strFile = Dir(strFolder & varItem & "\" & "*.doc")
Do While strFile <> ""
Set file = Documents.Open(FileName:=strFolder & _
varItem & "\" & strFile)
Use CMD to get all the files into an array and work with that instead - quicker and cleaner.
Sub S_O()
Dim fileArray As Variant
fileArray = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & strFolder & "\*.doc*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
For Each fil In fileArray
'//
'// Insert your code for doing the replacements here
'// e.g. Workbooks.Open(fil)
'// ...
Next
End Sub
I am trying to set up a macro to pull all excel files in a folder into a database in access. I have the below code, but when I run the macro, it errors out into "No Files Found," so intFile = 0. However, there are files in the chosen folder. Why is it not finding them? I think I messed up the linking piece too but one problem at a time. I am obviously pretty new to VBA, so any help would be appreciated!
Thanks,
Option Compare Database
Option Explicit
'code will link to excel and pull site survey files into access tables
'Setting the path for the directory
Const strPath As String = "S:\LOG\PURCHASI\Daniel Binkoski\Outlook Attachments\R7398Z Look Forward Daily Snapshot"
'FileName
Dim strFile As String
'Array
Dim strFileList() As String
'File Number
Dim intFile As Integer
Sub Sample()
strFile = Dir(strPath & "*.xlsx")
'Looping through the folder and building the file list
strFile = Dir(strPath & "*.xlsx")
While strFile <> ""
'adding files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'checking to see if files where found
If intFile = 0 Then
MsgBox "No Files Found"
Exit Sub
End If
'going through the files and linking them to access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferSpreadsheet acLink, , _
strFileList(intFile), strPath & strFileList(intFile), True, "A1:M50"
Next
MsgBox UBound(strFileList) & "Files were linked"
End Sub
try:
strFile = Dir(strPath & "\*.xlsx", vbNormal)
or add a final "\" onto your strPath value
You need another path separator to show you're looking in a directory, not at one.
I often use something like:
Dir(strPath & IIf(Right(strPath, 1) = "\", vbNullString, "\"))
as a check to ensure that the path always ends in a trailing backslash.