Issues using wildcards with strings in Dir function VBA - vba

I am currently working on user customisability in VBA while searching through some other workbooks. I am having issues converting my FileName expression in the Dir() function into a path directory with the correct backslash after my folder name, and then using wildcards around File to allow Dir to search for all occurrences of a keyword. Currently I believe the \ is omitted, and I can't yet tell if my wildcards are working
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & "*" & File & "*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
I am assuming my syntax is incorrect for what I am trying to achieve. Any help would be appreciated!
EDIT:
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & File & "*" & ".xls")
Debug.Print (FileName)
' Loop until Dir returns an empty string.
Do While FileName <> ""
Is what I am currently working with. The "\" in my Dir line doesn't seem to do anything as I still have to add the final \ before the file manually for it to appear in my error message.

When I tried your code it worked for me. Needless to say, that makes it a little tricky to provide a satisfactory answer!
Below is my attempt to solve the same problem.
Instead of asking the user to manually type the folder address I've used Excel's built-in folder picker. This avoids the need to check for and deal with typos.
Sub FindFiles()
Dim fldDialog As FileDialog ' Holds a reference to the folder picker.
Dim path As String ' Folder selected by user.
Dim fileFilter As String ' Provided by user, wildcard supported.
Dim found As String ' Used to display returned results.
' Config dialog.
Set fldDialog = Application.FileDialog(msoFileDialogFolderPicker)
fldDialog.Title = "Pick a folder" ' Caption for dialog.
fldDialog.AllowMultiSelect = False ' Limit to one folder.
fldDialog.InitialFileName = "C:\" ' Default starting folder.
' Display to user.
If fldDialog.Show Then
' Config filter.
path = fldDialog.SelectedItems(1)
fileFilter = InputBox("Select a filter (*.*)", "File filter", "*.*")
' Get results.
found = Dir(path & "\" & fileFilter)
Do Until found = vbNullString
MsgBox found, vbInformation, "File found"
found = Dir()
Loop
Else
MsgBox "User pressed cancel", vbInformation, "Folder picker"
End If
End Sub

Related

Excel VBA. Search tool

I am a beginner with Excel VBA and have some questions.
I want to search a specified folder based on user input (a file name). I can get that part to work, however, I want it to search for more than just the one format (.docx), and also include a search of both .pdf and .doc.
Clarification:
The folder under G:\NEWFOLDER\NAMEFOLDER contains files with extensions .doc, .docx, and .pdf and I want to search the entire folder and report back to my spreadsheet on Sheet2.
Dim NAME As String
Dim File_Path As String
NAME = InputBox(" Enter Your NAME (EX: JOHNP) ")
File_Path = "G:\NEWFOLDER\NAMEFOLDER" & NAME & ".docx"
If Dir(File_Path) <> "" Then
ThisWorkbook.Sheets("Sheet2").Activate
Range("D5") = ("Checked")
Range("E5") = NAME
Else
MsgBox "NAME Not found"
End If
End Sub
How do I search the document within?
Clarification:
The above code only tells me if the user input is located inside the coded path. The next step I want to do is to search within that document for keyword and report back to spreadsheet. For example, within JOHNP.doc there is a column of age. I want the code to report back to Sheet2 cell with "22".
Is this even possible with word document search, or is it better if the JOHNP is in excel format?
This should help you a little bit - This will cycle through files in the named folder location (if it exists), and will only target ones that are .doc, .docx or .pdf.
As for your second question - Yes, you can pull that number from your documents, however, you'll need to be more specific as to where that number is. If it's in the same spot each time, then that would be fairly easy - hopefully in a Table, then it would have an explicit reference (like ActiveDocument.Tables(1).Cells(1,1), etc. For now, this code below will go through all the files and when it finds the first match, it'll open the word document for you (then exit the loop).
Sub Test()
Dim NAME As String
Dim File_Path As String
Dim StrFile As String
NAME = InputBox(" Enter Your NAME (EX: JOHNP) ")
File_Path = "G:\NEWFOLDER\NAMEFOLDER\" & NAME & "\"
StrFile = Dir(File_Path)
If Dir(File_Path) <> "" Then
Do While Len(StrFile) > 0
If InStr(StrFile, ".doc") > 0 Or _
InStr(StrFile, ".pdf") > 0 Then
Debug.Print StrFile
'ThisWorkbook.Sheets("Sheet2").Range("D5") = ("Checked")
'ThisWorkbook.Sheets("Sheet2").Range("E5") = NAME
If InStr(StrFile, ".doc") > 0 Then
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open File_Path & StrFile
wordapp.Visible = True
Exit Do
End If
End If
StrFile = Dir
Loop
Else
MsgBox NAME & " Not found"
End If
End Sub

Avoid "Save as" dialog while converting Excel to XML using VBA script

I am trying to write a VBA Script which converts the excel file to XML. I am fetching the file name using Application.GetSaveAsFilename() function. But this function opens up the "Save As" dialog box. I want to suppress the dialog such that the user is not prompted to manually click save each time the code is run. Instead, the XML should be silently generated at the location hard-coded.
Code:
Sub BasicRTE()
Dim FileName As Variant
Dim Sep As String
Dim Ws As Worksheet
Dim autoSetFileName As String
Dim folderName As String
Dim location As Integer
ChDrive (Left(ThisWorkbook.Path, 1))
ChDir ThisWorkbook.Path
ChDir ".."
ChDir "InputFiles"
Application.SendKeys ("{ENTER}")
FileName = Application.GetSaveAsFilename( _
InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
FileFilter:="Xml Files (*.xml),*.xml")
location = InStrRev(FileName, "\", , vbTextCompare)
folderName = Mid(FileName, 1, location - 1)
For Each Ws In ThisWorkbook.Worksheets
If InStr(1, Ws.Name, "#", vbTextCompare) <> 1 Then
ExportToMyXMLFile FName:=CStr(folderName & "\" & Ws.Name & ".xml"), Sep:=CStr(Sep), _
AppendData:=False, Ws:=Ws
End If
Next
End Sub
It appears that the only thing you are using Application.GetSaveAsFilename for is to get the path to the InputFiles path with respect to the location of ThisWorkbook into folderName. The operating system already provides that! The following changes should work (but I have not tested them myself):
' fileName = ... ' don't need this
' location = ... ' or this
folderName = ThisWorkbook.Path & "\..\InputFiles" ' e.g., C:\Users\Foo\Documents\..\InputFiles
Alternatively, if you want a cleaner string,
Dim location as Long ' Never use Integer unless you are calling Win32 or something else esoteric
' Don't need any of this unless later code relies on the current directory
' (which it shouldn't, for robustness).
'ChDrive (Left(ThisWorkbook.Path, 1))
'ChDir ThisWorkbook.Path
'ChDir ".."
'ChDir "InputFiles"
'Application.SendKeys ("{ENTER}")
'FileName = Application.GetSaveAsFilename( _
' InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
' FileFilter:="Xml Files (*.xml),*.xml")
folderName = ThisWorkbook.Path
location = InStrRev(folderName, "\", , vbTextCompare)
folderName = Mid(folderName, 1, location) & "InputFiles"
For Each ws ...
The InStrRev+Mid drops the last path component, just like .., and then the & "InputFiles" puts InputFiles on the end.
One caution: ThisWorkbook.Path is an empty string for a new, unsaved workbook. Make sure your workbook is saved to disk before using the above.
Edit another caution: you are using ws.Name directly in making filenames. However, sheet names can include text that filenames cannot. I can name a sheet CON or <foo>, but neither of those is valid in a filename. Here's one example of sanitizing filenames (a quick Google result — not tested). However, even that example does not appear to check for reserved names.
Reserved names: CON, PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1, LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9 per MS).

Go up one folder level

I have a Macro that gets sub folder data. However I also want something from the main folder.
I looked at How to get current working directory using vba? but need to change activeworkbook path:
Application.ActiveWorkbook.Path might be "c:\parent\subfolder"
I would want
"c:\parent\"
Using Excel 365 VBA
As the path may not be the current working directory you need to extract the path from the string.
Find the last \ and read all characters to the left:
ParentPath = Left$(Path, InStrRev(Path, "\"))
If you are working around the current directory ChDir ".." will jump you up one level, the new path can be returned by CurrDir.
The most reliable way to do this is to use the Scripting.FileSystemObject. It has a method that will get the parent folder without trying to parse it:
With CreateObject("Scripting.FileSystemObject")
Debug.Print .GetParentFolderName(Application.ActiveWorkbook.Path)
End With
Dim WbDir As String
Dim OneLvlUpDir As String
'get current WorkBook directory
WbDir = Application.ActiveWorkbook.Path
'get directory one level up
ChDir WbDir
ChDir ".."
'print new working directory and save as string. Use as needed.
Debug.Print CurDir()
OneLvlUpDir = CurDir()
I think you mean this solution:
Sub t()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox "ThisWorkbook.Path = " & ThisWorkbook.Path & vbLf & _
"Path one folder down = " & fso.GetFolder(ThisWorkbook.Path & "\." & "NewFolder").Path
Set fso = Nothing
End Sub

Opening files in folder with loop

I am trying to open excel files from a folder and copy and paste details into a master folder. Within each first level folder, there are some .xlsm files available to open, but there are also some within a second level folder within the first level folder (so an extra \filepath).
Right now, I am trying to figure out how to loop through the first level folder and open the "loose" workbooks (files in the first level folder that ARE NOT in a second level folder).
This is what I have. Please note I will eventually add another "level" of folders, hence the large amount of variables:
Sub Compile_RFQ_Parts()
Dim RFQ_Ecoat As String 'file path for RFQ folder in ecoat folder
Dim RFQ_VendorFolder As String 'file path for specific vendor
Dim RFQ_FileFolder As String 'file path for RFQ folder within a vendor folder
Dim RFQ_File As String 'file within RFQ #### style folder in vendor folder
Dim RFQ_FileLooseVendor As String 'loose file in vendor folder
Dim RFQ_FileLooseEcoat As String 'loose file in ecoat RFQ folder
Dim RFQ_Num As String 'Number of RFQ from formula
Dim DumpLocation As String 'Bulk workbook
Dim DumpSheet As String 'Target sheet in bulk workbook
Dim NextOpenCellRow As Integer 'next open cell at the dump location
Dim RFQcell As Range 'counter for each cell in "part number" range in RFQ file
Dim RFQrange As Range 'range to look for part numbers in RFQ file
Define Variables
RFQ_Ecoat = "S:\FACILITY\Sales\RFQ"
RFQ_VendorFolder = RFQ_Ecoat & "\Jensen Metals"
RFQ_FileLooseVendor = Dir(RFQ_VendorFolder & "\*.xlsm") 'wildcard to open spreadsheets
DumpLocation = "RFQ_Compile test target.xlsx"
DumpSheet = "Sheet1"
Begin Loop
'######loop through each .xlsm file in a Vendor folder (not in RFQ folder but loose in vendor folder)######
Do While RFQ_FileLooseVendor <> ""
Application.DisplayAlerts = False
Workbooks.Open Filename:=RFQ_VendorFolder & "\" & RFQ_FileLooseVendor, UpdateLinks:=False
Application.DisplayAlerts = True
'vvvvvv%%%%%%%%%Copy and pasting operations%%%%%%%%%vvvvvv
Next File in loop within Folder
Next
'#########close RFQ and loop to the next RFQ_FileLooseVendor#########
Application.DisplayAlerts = False
Workbooks(RFQ_FileLooseVendor).Close
Application.DisplayAlerts = True
RFQ_FileLooseVendor = Dir() '<<<This clears my RFQ_FileLooseVendor string, which ends my Do While loop before getting to other files
Loop
End Sub
When I get to the RFQ_FileLooseVendor=dir() line, it clears that variable (makes it = ""). I have seen this on countless other forums and I can't understand how it does not immediately end the Do While loop for everyone else like it does for me.
ISSUE WAS RESOLVED: It turns out it was something I used in my for loop within the do while loop. I used a Dir() function to equal the value of a cell. Creating a new variable as a string and having equate to my Dir() function solved it.
Was:
Workbooks(DumpLocation).Sheets(DumpSheet) _
.Range("A" & NextOpenCellRow + 1).Value =Dir(RFQ_VendorFolder, vbDirectory)
is now:
Workbooks(DumpLocation).Sheets(DumpSheet) _
.Range("A" & NextOpenCellRow + 1).Value = RFQ_Vendor

Path not found when creating folder in Excel VBA [duplicate]

This question already has an answer here:
Excel VBA - MkDir returns "Path not Found" when using variable
(1 answer)
Closed 8 years ago.
I have a VBA subroutine to loop through the rows of an excel spreadsheet and copy a file from the path stored in one cell to a path made up of information from several other cells. Much of the time a folder will need to be created for the file but it's only one level deeper (not trying to However, when I run it I sometimes will get a runtime error 76 path not found. When I look at the folder in Windows Explorer the folder appears, but is slightly transparent (like a file that is being written to).
Why am I running into this error at fso.Createfolder strDirPath? I'm guessing this has to do with timing because when I run the script again it can pass over the file just fine. Is there some way to check that the folder is ready?
Sub CopyFiles()
' Copy to location [root_folder]\company_name\contract_no'_'file_name
Dim strRootFolder, strCompany, strContract, strFileName, strDirPath
Dim strFullPath, strFromPath, intRow
strRootFolder = "C:\...\DestinationFolder\"
intRow = 2
Dim fso As New FileSystemObject
'Loop through rows
Range("C" & 2).Select 'First row to check (column always filled)
Do Until IsEmpty(ActiveCell) ' Loop through till end of spreadsheet
strFromPath = objSheet.Range("C" & intRow).Value
' Replace "/" characters in company names with "_"
strCompany = Replace(objSheet.Range("E" & intRow).Value, "/", "_")
strContract = objSheet.Range("A" & intRow).Value & "_"
' Replace "#" in file names with "0"
strFileName = Replace(objSheet.Range("B" & intRow).Value, "#", "0")
strDirPath = strRootFolder & strCompany & "\"
strFullPath = strDirPath & strContract & strFileName
' Create directory if it does not exist
If Not fso.FolderExists(strDirPath) Then
fso.Createfolder strDirPath ' !!! This is where the error is !!!
End If
' Copy file
fso.CopyFile strFromPath, strFullPath, False
intRow = intRow + 1
ActiveCell.Offset(1, 0).Select ' drop one to check if filled
Loop
End Sub
Note: This is not because of a backslash in the directory name. The code replaces backslashes and there are no forward slashes in the input.
The issue is that the directory that is being created ends in a space. In Windows explorer, if you create a folder with a space at the end it automatically trims the name. However, in VBA it isn't automatically done.
The fix is to call Trim() around your directory name:
strDirPath = Trim(strRootFolder & strCompany) & "\"
Tip:
The folders with trailing spaces were created but will cause issues in Windows. To rename or remove them you will need to use the command line with a network path syntax. (See Rename/Delete Windows (x64) folder with leading and trailing space)
rename "\\?\c:\<PATH HERE>\ 1 " "<NEW FILE NAME>"