Using VBA to open files in a folder using partial file names

ESmith3187

New Member
Joined
Mar 22, 2017
Messages
5
I found the code below but it is not working.

I am trying to find a code that will find a file utilizing where only the first two characters in the file name are know.
This is in Excel 2010. My file names will always be AA_MMM_YYYY.xlsx, BB_MMM_YYYY, CC_MMM_YYYY where the "MMM" changes
each month to the current month.

I found the following code but it is not working. Any insight is appreciated.

Code:
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\JohnDoe\Desktop\2017"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
    Workbooks.Open Filename:=MyFolder & "" & MyFile
    MyFile = Dir
Loop
End Sub
 
Last edited by a moderator:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hi ESmith3187,

Welcome to MrExcel!!

See how this goes:

Code:
Option Explicit
Sub OpenFiles()
    
    Dim MyFolder As String
    Dim MyFile As String
    
    MyFolder = "C:\Users\JohnDoe\Desktop\2017\" 'EXACT folder name containing the files. Change to suit, but don't forget the trailing backslash '\'
    MyFile = Dir(MyFolder & "\*.xlsx")
    
    Do Until MyFile = ""
        Workbooks.Open Filename:=MyFolder & "" & MyFile
        MyFile = Dir
    Loop
    
End Sub

Note that from Excel 2007 there are several more workbook types than an Excel (Macro free) workbook i.e. xlsx extension that the above code will only open.

Regards,

Robert
 
Upvote 0
Robert, thanks! I do see where I entered my code in the wrong format here, so will ensure I fix that. But I appreciate your reply. I will test it in the morning at work, and will reply here on how it goes. And the files I will be opening are .xlsx.
 
Upvote 0
Sounds good. Thanks for like btw :)


You're welcome, and the code works well. I modified it to search for partial filename, so it meets the need perfectly.

Code:
Sub AAonly()
    Dim MyFolder As String, ThisMonth As String
    Dim MyFile As String
    ThisMonth = Format(Date, "mmmm")
    MyFolder = "H:\Folder\2017\" & ThisMonth & "\"
    MyFile = Dir(MyFolder & "\AA*.xlsx")
    Do Until MyFile = ""
        Workbooks.Open Filename:=MyFolder & "" & MyFile
        MyFile = Dir
        
    Call AA_XXXX_Template
    Loop
End Sub

[\CODE]
 
Upvote 0
I have a similar issue but I need the VBA to go through a list of partial subfolder names and copy all the PDF files from each subfolder and copy in one folder
 
Upvote 0
I have a similar issue but I need the VBA to go through a list of partial subfolder names and copy all the PDF files from each subfolder and copy in one folder
Hi - Did you manage to sort your request? I want to do the same thing.
 
Upvote 0
Hi Jojo Dthird and TAJSanderson,

Once a thread has been solved it's best to start a new one with a link back to the original thread if you think it will help. That said, try this (note it won't work if you're using Citrix):

VBA Code:
Option Explicit
Sub Macro1()

    Dim strInitialFolder As String, strPasteFilesPath As String
    
    strInitialFolder = "C:\MS_Office\Excel" '<< Starting directory to look for the PDF's. Change to suit. Can also be a reference to a worksheet cell.
    strInitialFolder = IIf(Right(strInitialFolder, 1) <> "\", strInitialFolder & "\", strInitialFolder)
    
    strPasteFilesPath = "C:\My PDF's\" '<< Directory to paste any found PDF's. Change to suit. Can also be a reference to a worksheet cell.
    strPasteFilesPath = IIf(Right(strPasteFilesPath, 1) <> "\", strPasteFilesPath & "\", strPasteFilesPath)
    
    Call CopyFiles(strInitialFolder, strPasteFilesPath, True) 'True to include looping through sub folders of the 'strInitialFolder' path, else False for just the 'strInitialFolder' path.
               
    MsgBox "PDF files have now been copied into:" & vbNewLine & """" & strPasteFilesPath & """", vbInformation
    
End Sub
Sub CopyFiles(strInitialFolderName As String, strPastePath As String, blnIncludeSubfolders As Boolean)

    Dim objFSO As Object
    Dim varSourceFolder As Variant, varFullPath As Variant, varSubFolder As Variant

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set varSourceFolder = objFSO.GetFolder(strInitialFolderName)
    
    For Each varFullPath In varSourceFolder.Files
        If StrConv(objFSO.GetExtensionName(varFullPath), vbLowerCase) = "pdf" Then
            Call objFSO.CopyFile(CStr(varFullPath), CStr(strPastePath & objFSO.GetFileName(varFullPath)), True)
        End If
    Next varFullPath
    
    If blnIncludeSubfolders = True Then
        For Each varSubFolder In varSourceFolder.SubFolders
            Call CopyFiles(varSubFolder.Path, strPastePath, True)
        Next varSubFolder
    End If
    
    Set varFullPath = Nothing
    Set varSourceFolder = Nothing
    Set objFSO = Nothing
    
End Sub

Regards,

Robert
 
Upvote 0
Here's another way that doesn't use FileSystemObject so should work in a Citrix environment too:

VBA Code:
Option Explicit
Sub Macro2()

    'Adapted from http://www.vbaexpress.com/forum/showthread.php?t=42813
   
On Error GoTo ErrCatch

    Dim strInitialDir As String, strPasteDir As String
    Dim strMyFiles() As String
    Dim lngLoopCounter As Long
   
    strInitialDir = "C:\MS_Office\Excel"  '<< Initial directory. Change to suit. Can also be a reference to a worksheet cell.
    strPasteDir = "C:\My PDF's\" '<< Directory to paste any found PDF's. Change to suit. Can also be a reference to a worksheet cell.
   
    strInitialDir = IIf(Right(strInitialDir, 1) <> "\", strInitialDir & "\", strInitialDir)
    strInitialDir = strInitialDir & "*.pdf"
    strPasteDir = IIf(Right(strPasteDir, 1) <> "\", strPasteDir & "\", strPasteDir)
   
    strMyFiles = Split(CreateObject("wscript.shell").exec("cmd /c Dir " & strInitialDir & " /b /s").stdout.readall, vbCrLf)
   
    If UBound(strMyFiles) = 0 Then
        MsgBox "There were no PDF files found from the start directory to copy.", vbExclamation
        Exit Sub
    Else
        For lngLoopCounter = LBound(strMyFiles) To UBound(strMyFiles) - 1
            FileCopy strMyFiles(lngLoopCounter), strPasteDir & Dir(strMyFiles(lngLoopCounter))
        Next lngLoopCounter
    End If
   
    MsgBox "PDF files have now been copied into:" & vbNewLine & """" & strPasteDir & """", vbInformation
   
    Exit Sub
   
ErrCatch:
   
    MsgBox "There was a problem copying one or all of the PDF files." & vbNewLine & "Details are:" & vbNewLine & Err.Number & ". " & Err.Description, vbCritical

End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top