Help with macro to see if files exist

[Damo10]

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

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

 

[shg]

Maybe ...

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

 

[Damo10]

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

 

[AlphaFrog]

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 & ".*"

 

[Damo10]

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

 

[shg]

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

 

[Damo10]

Thanks that works great now

Regards

Damian

 

[Damo10]

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?

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