Open or create file with calendar

[Kuledoode]

I need to accomplish the following with very little VBA experience!!

Click on a cell that contains a date
Check to see if a file exists using the selected date, "C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table\date"
If it does open it
If it doesn't, create it from a template "C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table Template" and save it as a new file with the date at the end in the LH folder
If another date is clicked while this workbook is still open, save and close this workbook before opening the newly selected date.
This is what I tried:

Sub File_Exists()
    Dim FileName As String
       FileName = VBA.FileSystem.Dir("C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table" & Target.Value)
    If FileName = VBA.Constants.vbNullString Then
        Workbooks.Open "C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table.xls"
        ThisWorkbook.SaveCopyAs "C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table\" & Target.Value
    Else
        'Update the path to a valid path on your PC
        Workbooks.Open "C:\Users\Jeff\OneDrive\LH\Events and Conference Points Table" & Target.Value
        
    End If
End Sub

 

[The_Macrotect]

Hi Kuledoode,

How do your date files look in the "Events and Conference Points Table" folder? (5112019, 190511, 51119, etc...)


All the best,
Matt

 

[Kuledoode]

The input is "2019-04-20" formatted to display as "April 20,2019"
FYI, Events and Conference Points Table is a workbook, not a folder. I have created this file to be used as a template. It should be saved as "Events and Conference Points Table 2019-04-20" in the "C:\Users\Jeff\OneDrive\LH" folder.

 

[The_Macrotect]

Ok how's this? Activate the cell with the desired date and run the macro. Be sure to back up your work first, and test this code on a copy:

Sub Check_File()

Dim File As String, DirFile As String

File = "Events and Conference Points Table " & Format(ActiveCell, "yyyy-mm-dd")
DirFile = "C:\Users\Jeff\OneDrive\LH"

If Dir(DirFile & File) = "" Then
Workbooks.Open Filename:=DirFile & "Events and Conference Points Table Template.xlsx"
ActiveWorkbook.SaveAs Filename:=DirFile & File
Else
Workbooks.Open Filename:=DirFile & File
End If

End Sub

 

[Kuledoode]

Thanks for helping out on this one. I really appreciate it.


I changed a few things:
- DirFile now is "C:/Users/Jeff/LH Points/"
- Template file is .xlms
- A hyperlink is assigned to each date in Calendar. Now user just clicks on a date to run code (extra sub added at bottom)
- A 'Save and Close' button was added to Template to ensure user entries were saved and numerous workbooks were not left open.

Sub Check_File()


Dim File As String, DirFile As String


File = "Event and Conference Points Table " & Format(ActiveCell, "yyyy-mm-dd")
DirFile = "C:\Users\Jeff\LH Points\"


If Dir(DirFile & File) = "" Then
Workbooks.Open FileName:=DirFile & "Event and Conference Points Table Template.xlsm"
[COLOR=#ff0000]ActiveWorkbook.SaveAs FileName:=DirFile & File [/COLOR][COLOR=#008000]'Macro fails here both scenarios[/COLOR][COLOR=#008000][/COLOR]
Else
Workbooks.Open FileName:=DirFile & File
End If


End Sub


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Call Check_File
End Sub

I clicked on April 8, 2019, added entries and performed 'Save and Close'. Calendar became active workbook. I clicked on the same date (as another user adding their own entries) and the macro failed:

A file named 'C:/Users/Jeff/LH Points/Event and Conference Points Table 2019-04-08.xlms' already exists. Do you want to replace it?

Runtime error '1004':Method 'SaveAs' of object '_Workbook' failed

I selected End to close the error message box, Template file was active workbook.


If 'Event and Conference Points Table 2019-04-08' is open and a user goes to Calendar and clicks on the same date the following error occurs:

Run-time error '1004':
You cannot save this workbook as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.

 

[The_Macrotect]

Try adding to the end of the File= statement: & ".xlsm" (shown below in green). Does this help?

Also, does your 'Save and Close' macro save it as .xlsm?

Sub Check_File()


Dim File As String, DirFile As String


File = "Event and Conference Points Table " & Format(ActiveCell, "yyyy-mm-dd"[COLOR=#008000] & ".xlsm"[/COLOR])
DirFile = "C:\Users\Jeff\LH Points\"


If Dir(DirFile & File) = "" Then
Workbooks.Open FileName:=DirFile & "Event and Conference Points Table Template.xlsm"
ActiveWorkbook.SaveAs FileName:=DirFile & File 'Macro fails here both scenarios
Else
Workbooks.Open FileName:=DirFile & File
End If


End Sub


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Call Check_File
End Sub

 

[Kuledoode]

That did it. Thanks.


Something happened... Excel update from Microsoft? My computer auto-updated? Not sure. Excel looks different. Now files save as .xl08 or .xl010 file type.

Event and Conference Points Table 2019-10-17.xl010

What on earth??
Excel doesn't recognize it from explorer. I can change the extension to .xlsm and it works fine.
Save and Close saved as .xlsm


I would also like to insert the relative date from activeCell in Calendar into A2 of the newly created file Event and Conference Points Table yyyy-mm-dd file. Any ideas?


This is what the code looks like now.

Sub Check_File()


Dim File As String, DirFile As String


File = "Event and Conference Points Table " & Format(ActiveCell, "yyyy-mm-dd" & ".xlsm")
DirFile = "C:\Users\Jeff\LH Points\"


If Dir(DirFile & File) = "" Then
    Workbooks.Open FileName:=DirFile & "Event and Conference Points Table Template.xlsm"
    ActiveWorkbook.SaveAs FileName:=DirFile & File
Else
    Workbooks.Open FileName:=DirFile & File
End If
End Sub




Private Sub CommandButton1_Click()
    Range("A3").Value = Range("G1")
End Sub


Private Sub CommandButton2_Click()
    Range("A3").Value = Range("H1")
End Sub


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Call Check_File
End Sub

 

[The_Macrotect]

It was giving me some funky extensions too; I just found out why: A misplaced parenthesis in the file= line. Sorry about that!

Here's revised code that corrects the problem and adds the date in cell A2 to newly created files:

Sub Check_File()

Dim File As String, DirFile As String, date_new As String

File = "Events and Conference Points Table " & Format(ActiveCell, "yyyy-mm-dd") & ".xlsx"
DirFile = "C:\Users\Jeff\OneDrive\LH"

If Len(Dir(DirFile & File)) = 0 Then
date_new = ActiveCell.Value
Workbooks.Open FileName:=DirFile & "Events and Conference Points Table Template.xlsx"
Range("A2") = date_new
ActiveWorkbook.SaveAs FileName:=DirFile & File
Else
Workbooks.Open FileName:=DirFile & File
End If

End Sub