0

I want to create a macro which open an excel folder in a file. Only problem I run into now is that I cant do this normally by a macro like:

Sub CopyDataFromWorksheet()

   Workbooks.Open ("dir\files\dashboard 24-01-2014.xls")

End Sub

Because the file I want to open contains a variable component. It has a fixed naam, dashboard, but also a date, 20 - 01 - 2014, which changes frequently. So I'm looking for code which:

  • Open a folder
  • Looks for xls files containing "Dashboard"
  • Open them.

Anybody thoughts on how I should code this?

Dear regards,

Marc

Community
  • 1
  • 1
user181796
  • 185
  • 7
  • 22
  • 1
    I think this http://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba will do for your case :) – parakmiakos Jan 24 '14 at 09:46
  • 1
    Look up the Dir function in VBA Help which will let you look for file names that include wildcards. For example: "Dashboard*.xls" will pick up any xls file that starts with "Dashboard". – Tony Dallimore Jan 24 '14 at 09:48

4 Answers4

2

Think you just need a very small change to your code:

Sub openAllFiles()

yourPath = "<your_file_path_ends_with\>"
file = Dir(yourPath & "Dashboard*.xls")
Do While file <> vbNullString
Workbooks.Open (yourPath & file)
file = Dir()
Loop
End Sub

workbooks.Open needs the full path instead of just the file name.

Alex
  • 1,632
  • 1
  • 12
  • 28
1

try this:

Sub loopdir()
Dim MyFile$, Fold$
'Dim FD As FileDialog
Dim WBCur As Workbook, WBFile As Workbook
Set WBCur = ActiveWorkbook

'''pick a folder with dialog
'Set FD = Application.FileDialog(msoFileDialogFolderPicker)
'With FD
'.Title = "Select a Folder"
'.AllowMultiSelect = False
'If .Show <> -1 Then Exit Sub
'Fold = .SelectedItems(1) & "\"
'End With
'Set FD = Nothing
'''or just
Fold = "<your folder here with \ in the end>"

MyFile = Dir(Fold & "dashboard*.xls*") 'last * for both xls and xlsx
Do While MyFile <> ""
    Workbooks.Open Filename:=Fold & MyFile
    Set WBFile = ActiveWorkbook
    '''your code here
    'Application.DisplayAlerts = False
    'WBFile.Close
    'Application.DisplayAlerts = True
    MyFile = Dir()
Loop
'Application.DisplayAlerts = True 'for sure
Set WBCur = Nothing
Set WBFile = Nothing
End Sub
PPh
  • 47
  • 3
1

This should work OK for you.

Sub openAllFiles()
yourPath="dir\files\"
file=Dir(yourPath & "Dashboard*.xls")
Do while file<>vbNullString
Workbooks.Open(yourpath & file)
file=Dir()
Loop
End Sub
bmgh1985
  • 779
  • 1
  • 14
  • 38
  • Thanks for your reply bmgh but if ran it with my selected folder i get bad name or number error. Any thoughts what might cause that? This is code I have now:Sub openAllFiles() yourPath = "X:\SSC_HR\SENS\Bedrijfsbureau\Rapportages\sterren\MAANDELIJKSE RAPPORTAGES\UITDRAAI DB_MAANDELIJKS_DASHBOARD\" file = Dir(yourPath & "Dashboard*.xls") Do While file <> vbNullString Workbooks.Open (file) file = Dir() Loop End Sub – user181796 Jan 24 '14 at 12:55
  • Only time I get that through testing is if the `yourPath` directory was either wrong, or you had left the "\" off the end. I would check your folder path and try it again. – bmgh1985 Jan 24 '14 at 15:58
0

Nice solution Alex. I took your answer one step further and a little bit to the side :) Instead of opening all similarly named files. I needed to open the Newest, similarly named file. So I did this...

Dim newest As Date
Dim current As Date
Dim right_file As String
Dim rot_cnt As Integer
rot_cnt = 1

Dim my_path As String
Dim file_name As String
my_path = "C:\Path\To\File\Dir\"
file_name = Dir(my_path & "My-Similar-Files*.xlsm")

Do While file_name <> vbNullString
    If rot_cnt = 1 Then
        newest = FileDateTime(my_path & file_name)
    End If
    If rot_cnt >= 1 Then
        current = FileDateTime(my_path & file_name)
    End If
    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) Then
        newest = FileDateTime(my_path & file_name)
        right_file = my_path & file_name
    End If
    file_name = Dir()
    rot_cnt = rot_cnt + 1
Loop

Workbooks.Open (right_file), UpdateLinks:=False, ReadOnly:=True

After further testing this uses the last save time over the "real" creation time so it may return unwanted results. BuiltinDocumentProperties("Creation Date") is also a false lead to creation date. This value is cloned if someone copies the workbook. To achieve the proper result without having to manually enable any new references, I used this.

Dim oFS As Object
Dim StrFile As String
Dim rot_cnt As Integer
rot_cnt = 1

Dim current As Date
Dim newest As Date
Dim right_file As String

Dim my_path As String
Dim file_name As String
my_path = "C:\Path\To\File\Dir\"
file_name = "My-Similar-Files*.xlsm"

StrFile = Dir(my_path & file_name)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If  
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

'The Right(StrFile, 6) If parameter is because Dir() also gives the exact 
'string of file_name as one of the values which we don't want to process.
    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop

Workbooks.Open (right_file), UpdateLinks:=False, ReadOnly:=True
SM177Y
  • 1
  • 1