Calculate This Friday's date and reformat VB

[tvman5683]

Hello,

I'm trying to identify an excel file (that I append to) that changes name every week on Friday. I found a few example that will correctly calculate next Friday's datebut I need to change the format to match the excel format. File is saved as Mysheet 01-15-16.xls. The code below returns 1/15/2016.
any help would be greatly appreciated.

NextFriday = Format(Date + 8 - Weekday(Date, vbFriday), dd - mm - yy)

 

[tvman5683]

Here's the line where I use the code. also tried a wildcard with no luck.

Set objXLBook = objXLApp.Workbooks.Open("C:\Work Files\Uploads\MySheet" & NextFriday & ".xls")

 

[Joe4]

The last argument of the FORMAT function should be between double quotes. Here is how you can do it:

    NextFriday = Format(Date + 8 - Weekday(Date, vbFriday), "mm-dd-yy")
    MyFileName = "Mysheet " & NextFriday & ".xls"
    MsgBox MyFileName

(just using a MsgBox to show you what the result looks like).

 

[tvman5683]

Message box results look like this


MySheet 1/15/2016.xls and then when it continues it cannot find to open.
If I hard code the date in it works so I know it can find the sheet when it reconizes the correct name. am i wrong to assume it's the date format? do you think a wild card could work? it will be the onle file in a folder.

Thanks
JB

 

[Joe4]

That is very odd. Mine doesn't do that (nor should it). I wonder if you got some special regional settings wreaking havoc with it.
So let's go with the flow and use the Replace function to replace those slashes with dashes, i.e.

    NextFriday = Replace(Format(Date + 8 - Weekday(Date, vbFriday), "mm/dd/yy"), "/", "-")
    MyFileName = "Mysheet " & NextFriday & ".xls"
    MsgBox MyFileName

 

[tvman5683]

Still getting the slashes. Here's the entire module. you might be able to run to the message box?

Sub AppendToSpreadsheet()
On Error GoTo HandleError
    
' Define Access and Excel object variables
Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")
Dim objXLBook As Excel.Workbook
Dim objResultsSheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim RowVal As Integer
Dim ColVal As Integer
Dim NextFriday As Date
NextFriday = Replace(Format(Date + 8 - Weekday(Date, vbFriday), "mm/dd/yy"), "/", "-")
    MyFileName = "8382 Melrose Webform " & NextFriday & ".xls"
    MsgBox MyFileName

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Web_Form")
    
    conPath = CurrentProject.path
    
    '  Open Excel sheet as an Excel Object
    Set objXLApp = Excel.Application
    Set objXLBook = objXLApp.Workbooks.Open("C:\Work Files\Uploads\MyFileName")
    Set objResultsSheet = objXLBook.Worksheets("Sheet1")
    
    RowVal = 1
    ColVal = 1
    
' Find the last row of data
    Do While Not objResultsSheet.Cells(RowVal, ColVal) = Empty
        RowVal = RowVal + 1
    Loop
    
' Write data from Access query to Spreadsheet
    Do While Not rs.EOF
        'objResultsSheet.Range(Cells(RowVal, ColVal + 0), Cells(RowVal, ColVal + 0)) = rs!Request_Type
        objResultsSheet.Range(Cells(RowVal, ColVal + 0), Cells(RowVal, ColVal + 0)) = rs!Request_Type
        objResultsSheet.Range(Cells(RowVal, ColVal + 1), Cells(RowVal, ColVal + 1)) = rs!DISTRICT
        objResultsSheet.Range(Cells(RowVal, ColVal + 2), Cells(RowVal, ColVal + 2)) = rs!TechID
        objResultsSheet.Range(Cells(RowVal, ColVal + 3), Cells(RowVal, ColVal + 3)) = rs!Request_Date
        objResultsSheet.Range(Cells(RowVal, ColVal + 4), Cells(RowVal, ColVal + 4)) = rs!Enterprise_ID
        objResultsSheet.Range(Cells(RowVal, ColVal + 5), Cells(RowVal, ColVal + 5)) = rs!Upload_Codes
        objResultsSheet.Range(Cells(RowVal, ColVal + 6), Cells(RowVal, ColVal + 6)) = rs!EFFECTIVE_DATE
        objResultsSheet.Range(Cells(RowVal, ColVal + 7), Cells(RowVal, ColVal + 7)) = rs!Tech_District_Info
        objResultsSheet.Range(Cells(RowVal, ColVal + 8), Cells(RowVal, ColVal + 8)) = rs!Tech_Specialty
        objResultsSheet.Range(Cells(RowVal, ColVal + 9), Cells(RowVal, ColVal + 9)) = rs!PDC
        objResultsSheet.Range(Cells(RowVal, ColVal + 10), Cells(RowVal, ColVal + 10)) = rs!State
        objResultsSheet.Range(Cells(RowVal, ColVal + 11), Cells(RowVal, ColVal + 11)) = rs!SEARSORAE
        objResultsSheet.Range(Cells(RowVal, ColVal + 12), Cells(RowVal, ColVal + 12)) = rs!C_U_S
        
        
        RowVal = RowVal + 1
        rs.MoveNext
    Loop
    
' Save and close spreadsheet
    objXLBook.Save
    objXLBook.Close
    MsgBox "Done!"
ProcDone:
    On Error Resume Next
    
    ' Let's clean up our act
    Set qdf = Nothing
    Set db = Nothing
    Set rs = Nothing
    Set objResultsSheet = Nothing
    Set objXLBook = Nothing
    Set objXLApp = Nothing
    
ExitHere:
    Exit Sub
HandleError:
    MsgBox Err.Description, vbExclamation, _
        "Error " & Err.Number
    Resume ProcDone
End Sub

 

[Joe4]

Here's your problem:

Dim NextFriday As Date

NextFriday needs to be declared a String! The FORMAT function returns a String value.
By declaring it as a date, it is converting the string back to a date, so it doesn't really matter what you try to do to change it after then.

Dim NextFriday As String

Also, this does not look correct:

Set objXLBook = objXLApp.Workbooks.Open("C:\Work Files\Uploads\MyFileName")

Anything enclosed between double-quotes is treated as literal text. Variables must be outside of the double-quotes, i.e.

Set objXLBook = objXLApp.Workbooks.Open("C:\Work Files\Uploads\" & MyFileName)

You can see this easily with this simple example.
Try these two lines of code, and see what each one returns:

MsgBox MyFileName
MsgBox "MyFileName"

 

[tvman5683]

It worked perfect! but of course you knew that it would. I knew I didn't have the "MyFileName" correct as I was originally using the actual file name there with the hard coded date. But I never got past the formatting issue.

I found the module on one of the sites and was trying to adapt it to my needs. I've learned quite a bit from doing that over the years. Only wish I could actually create something like it.

thanks for all you help and again you have taught me to fish! Hope this might help someone else too. Have a great New Year!

JB

 

[Joe4]

You are welcome. Glad you got it working out, and learned some new stuff along the the way!

 

[tvman5683]

fyi, you had it right the first time. No need for the replace even though it also worked perfectly!

'NextFriday = Replace(Format(Date + 8 - Weekday(Date, vbFriday), "mm/dd/yy"), "/", "-")    'MyFileName = "8382 Melrose Webform " & NextFriday & ".xls"
    'MsgBox MyFileName


NextFriday = Format(Date + 8 - Weekday(Date, vbFriday), "mm-dd-yy")
    MyFileName = "8382 Melrose Webform " & NextFriday & ".xls"
    MsgBox MyFileName
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Web_Form")
    
    conPath = CurrentProject.path
    
    '  Open Excel sheet as an Excel Object
    Set objXLApp = Excel.Application
    Set objXLBook = objXLApp.Workbooks.Open("C:\Work Files\Uploads\" & MyFileName)
    Set objResultsSheet = objXLBook.Worksheets("Sheet1")