Help with macro to see if files exist

Damo10

Active Member
Joined
Dec 13, 2010
Messages
460
Hi,

I have written the following code to have the user enter the date of the files they want to open and then to have all 4 files open.

The issue I have is how to check that all the files exist before opening any of them?

Please help

Code:
Sub Import()
Dim D As String
Dim wb As Workbook
Dim File1 As String
Dim File2 As String
Dim File3 As String
Dim File4 As String

D = InputBox("Enter Date" & Chr(10) & Chr(10) & "Format DD-MM-YYYY", "Select File Date")
D = Format(D, "DD-MM-YYYY")
ChDir ("C:\Users\Damian\Desktop")
File1 = "71MM Packsheets - " & D
File2 = "86MM Packsheets - " & D
File3 = "Cluster Packsheets - " & D
File4 = "Natural Packsheets - " & D

With Workbooks.Open(Filename:=File1, ReadOnly:=True, UpdateLinks:=False)
End With
With Workbooks.Open(Filename:=File2, ReadOnly:=True, UpdateLinks:=False)
End With
With Workbooks.Open(Filename:=File3, ReadOnly:=True, UpdateLinks:=False)
End With
With Workbooks.Open(Filename:=File4, ReadOnly:=True, UpdateLinks:=False)
End With
 
End Sub

Regards Damian
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Maybe ...

Code:
Sub Import()
    Const sDir      As String = "C:\Users\Damian\Desktop\"
    Dim sDate       As String
    Dim avsFile     As Variant
    Dim i           As Long

    sDate = InputBox(Prompt:="Enter Date" & vbLf & vbLf & _
                             "Format DD-MM-YYYY", _
                     Title:="Select File Date")
    sDate = Format(sDate, "DD-MM-YYYY")

    avsFile = Array(sDir & "71MM Packsheets - " & sDate, _
                    sDir & "86MM Packsheets - " & sDate, _
                    sDir & "Cluster Packsheets - " & sDate, _
                    sDir & "Natural Packsheets - " & sDate)

    For i = 0 To UBound(avsFile)
        If Len(Dir(avsFile(i))) Then
            Workbooks.Open Filename:=avsFile(i), _
                           ReadOnly:=True, _
                           UpdateLinks:=False
        End If
    Next i
End Sub
 
Upvote 0
Hi Shg,

Thanks for the reply, I tried the code and it did not open any files even if they all exist.

Could you also include a messagebox with which files dont exist if all 4 are not present?

When each file is opened I will want to run another macro to import some data from each file to this workbook, the macros are different for each file. I already have the code for these but can you tell me where I would put it?

Regards
 
Upvote 0
You may need to include the file name extension or a wildcard for each file e.g.

sDir & "71MM Packsheets - " & sDate & ".xls"

Or

sDir & "71MM Packsheets - " & sDate & ".*"
 
Upvote 0
Hi AlphaFrog,

Yes you were correct it just needed the file extension.

It now opens the files but it still opens them even if 1 or more is missing, can it be ammended so that it only runs if all 4 files are present?
If 1 or more are missing can a messagebox inform which one/s are missing?
I want to run a macro depending on which file has just been opened before the next one opens how can this be included?

Regards

Damian
 
Upvote 0
Code:
Sub Import()
    Const sDir      As String = "C:\Users\Damian\Desktop\"
    Const sExt      As String = ".xls"
    Dim sDate       As String
    Dim avsFile     As Variant
    Dim i           As Long

    sDate = InputBox(Prompt:="Enter Date" & vbLf & vbLf & _
                             "Format DD-MM-YYYY", _
                     Title:="Select File Date")
    sDate = Format(sDate, "DD-MM-YYYY")

    avsFile = Array(sDir & "71MM Packsheets - " & sDate & sExt, _
                    sDir & "86MM Packsheets - " & sDate & sExt, _
                    sDir & "Cluster Packsheets - " & sDate & sExt, _
                    sDir & "Natural Packsheets - " & sDate & sExt)

    For i = 0 To UBound(avsFile)
        If Len(Dir(avsFile(i))) Then
            Workbooks.Open Filename:=avsFile(i), _
                           ReadOnly:=True, _
                           UpdateLinks:=False
            Else
                MsgBox avsFile(i) & " is missing in action! Bye."
                Exit Sub
        End If
    Next i
End Sub
 
Upvote 0
Hi,

I have included the code to run depending on which workbook has been opened, the only issue I have is how do I close the workbook as I get an error on the lines in red, can you please help?

Rich (BB code):
For i = 0 To UBound(avsFile)
        If Len(Dir(avsFile(i))) Then
            Workbooks.Open Filename:=avsFile(i), _
                           ReadOnly:=True, _
                           UpdateLinks:=False
                           
                           If i = 0 Then
                                Set wks = Sheet4
                                Set wksSBC = Sheet3
                           
                            With avsFile(i)
                                Worksheets("Profiles").Range("A1:W1809").Copy
                                wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Worksheets("Data").Range("A5:FZ2000").Copy
                                wksSBC.Range("A5").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Worksheets("Fruit").Range("C13:J1000").Copy
                                wksSBC.Range("HA5").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Close SaveChanges:=False
                            End With
                            End If
                           If i = 1 Then
                           
                           Set wks = Sheet5
                           
                            With avsFile(i)
                                Worksheets("Profiles").Range("A1:W1809").Copy
                                wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Close SaveChanges:=False
                            End With
                            End If
                           If i = 2 Then
                           
                           Set wks = Sheet6
                           
                            With avsFile(i)
                                Worksheets("Profiles").Range("A1:W1809").Copy
                                wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Close SaveChanges:=False
                            End With
                            End If
                           
                           If i = 3 Then
                           
                           Set wks = Sheet7
                           
                           With avsFile(i)
                                Worksheets("Profiles").Range("A1:W1809").Copy
                                wks.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                Application.CutCopyMode = False
                                Close SaveChanges:=False
                            End With
                            End If
                           
            Else
                MsgBox avsFile(i) & " is missing in action! Bye."
                Exit Sub
        End If
    Next

Regards
 
Upvote 0

Forum statistics

Threads
1,211,852
Messages
6,104,367
Members
447,902
Latest member
chriswebs23

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