PDA

View Full Version : Open Files that include todays date



Sir Babydum GBE
09-06-2012, 08:49 AM
Hi

My Macro asks the user to locate 2 files in a specified folder before it interrogates them (the files, not the user).

I would like to streamline things a little and have the whole process automated.

The Files are in the Folder "D/Babydum" and there is a file containing today's orders titled thus: "Order DD-MM-YYYY-#####.xls"
I need the macro to look through the files in that folder and open the one that contains 26 characters (if you count the ".xls") AND where the first 16 characters contain the expression "Order DD-MM-YYYY" (Where the letters are replaced with the digits of today's date, of course).

IF it cannot find a match then the open dialogue box will appear allowing the user to search for it.

THe same for the second file except that it is simply looking for a file entitled "ABC DDMMYYYY.csv" (No hyphens separating the date digits)

Again, if not found then the user will get a chance to look for it himself.

Once the files are found then it gets on with its business, allowing the user time to make a coffee and eat a sandwich.

Many thx in advance

Sir BD

CatDaddy
09-06-2012, 11:08 AM
Sub f_opener()
Dim FSO, folder, file As Variant
Dim fileArr(1 To 100) As Variant
Dim wb As Workbook
Dim directory, s1, s2, lst As String
Dim x, xx, i, choice As Integer
s1 = "Order " & Format(Date, "dd-mm-yyy")
s2 = "ABC " & Format(Date, "ddmmyyyy")
x = xx = choice = 0
i = 1

directory = "C:\TEST"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(directory)
For Each file In folder.Files
If InStr(file.Name, s1) Then
Workbooks.Open file
x = 1
ElseIf InStr(file.Name, s2) Then
Workbooks.Open file
x = 1
End If

lst = i & ") " & file.Name & vbCrLf
fileArr(i) = file
i = i + 1

Next file
If x = 0 Or xx = 0 Then
If x = 0 And xx = 0 Then
For i = 1 To 2
Do While choice = 0
On Error Resume Next
choice = CInt(InputBox(lst))
Workbooks.Open fileArr(i)
Loop
Next i
Else
Do While choice = 0
On Error Resume Next
choice = CInt(InputBox(lst))
Workbooks.Open fileArr(i)
Loop
End If
End If

End Sub

GTO
09-06-2012, 01:29 PM
A friendly Howdy from Arizona :-)

Here was my take:

Option Explicit

Sub DoStuff()
Dim FSO As Object ' FileSystemObject
Dim WB2Pass As Workbook
Dim WB As Workbook
Dim CSV As Workbook
Dim Path As String

Set FSO = CreateObject("Scripting.FileSystemObject")

Path = ThisWorkbook.Path & "\"

If ReturnAWorkbook(FSO:=FSO, _
WB:=WB2Pass, _
Path:=Path, _
Pattern:="Order " & Format(Date, "DD-MM-YYYY") & "-#####.xls*", _
Msg:="Select Workbook") Then
Set WB = WB2Pass
End If
Set WB2Pass = Nothing
If ReturnAWorkbook(FSO, WB2Pass, Path, _
"ABC " & Format(Date, "DDMMYYYY") & ".csv", "Select CSV") Then
Set CSV = WB2Pass
End If
Set WB2Pass = Nothing

If WB Is Nothing Or CSV Is Nothing Then
On Error Resume Next
'// Close anything that did get opened and bail... //
WB.Close False
CSV.Close False
On Error GoTo 0
MsgBox "We have problems Houston..."
Exit Sub
End If

'...make a coffee and eat a sandwich.

End Sub

Function ReturnAWorkbook(FSO As Object, _
WB As Workbook, _
Path As String, _
ByVal Pattern As String, _
ByVal Msg As String _
) As Boolean
Dim fsoFolder As Object ' Folder
Dim fsoFile As Object ' File
Dim FileName As String

If FSO.FolderExists(Path) Then
For Each fsoFile In FSO.GetFolder(Path).Files
If fsoFile.Name Like Pattern Then
Set WB = Workbooks.Open(Path & fsoFile.Name)
Exit For
End If
Next
End If

If WB Is Nothing Then
FileName = Application.GetOpenFilename("Excel Files (*.xls*; *.csv),*.xls*;*.csv", , Msg)
If Not FileName = "False" Then
Set WB = Workbooks.Open(FileName)
End If
End If

If Not WB Is Nothing Then ReturnAWorkbook = True
End Function

Hope that helps,

Mark