0

I've got a simple question about an idea how to do something. My macro needs to save currently opened workbook as a new one. Normally it is simple, but in case that file name contains some date, it needs to be changed to today date.

Some examples:

  • (...) 2015-01-01.xls needs to be saved as (...) v2016-04-08.xlsm
  • (...) 01-01-2015.xlsm needs to be saved as (...) v2016-04-08.xlsm
  • (...) & every other date format needs to be saved as (...) v2016-04-08.xlsm
  • (...).xls needs to be saved as (...) v2016-04-08.xlsm

My question is how can i do it as simple as possible? Should i code a bunch of IFs? And finally how to replace it? In IF i can use LIKE operator, but in replace i need to provide raw string in argument..

Thanks for your time and help!

Damian
  • 5
  • 1
  • 4
  • i would recommend regular expressions -> http://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops – Doktor OSwaldo Apr 08 '16 at 09:09

2 Answers2

0

I found this code here: http://www.mrexcel.com/forum/excel-questions/632128-visual-basic-applications-extract-date-text.html

I've updated it for a single date and to return the date in a string but you'll need to update the Pattern to deal with other formats. Hopefully someone else can help you with that.

Sub CallIt()
Dim MyDate As String
    If DateRet(Range("B2").Text, MyDate) Then
        MsgBox MyDate
    Else
        '... something to handle if the string is glitched in some manner.
    End If
End Sub

Function DateRet(ByVal CellText As String, sDate As String) As Boolean
    Static REX          As Object ' RegExp
    Dim rexMC           As Object ' MatchCollection
    Dim dTemp           As Date
    Dim ValsSplit       As Variant

    If REX Is Nothing Then
        Set REX = CreateObject("VBScript.RegExp")
        With REX
            .Global = True
            .Pattern = "\b[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{4}\b"
        End With
    End If

    With REX
        If .Test(CellText) Then
            Set rexMC = .Execute(CellText)
            If rexMC.Count = 1 Then
                sDate = .Execute(CellText)(0)
                DateRet = True
            Else
                DateRet = False
            End If
        Else
            DateRet = False
        End If
    End With
End Function
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45
0

edited after the OP's comment

you could try this

Option Explicit

Sub main()
Dim wbName As String, wbExt As String

With ActiveWorkbook
    wbName = Mid(.Name, 1, InStrRev(.Name, ".") - 1)
    wbExt = Mid(.Name, InStrRev(.Name, "."))

    If IsDate(Right(wbName, Len(wbName) - InStrRev(wbName, " "))) Then ' check for a possible "date" part ofthe name
        wbName = Left(wbName, InStrRev(wbName, " ")) & "v" & Format(Date, "yyyy-mm-dd")
    Else
        wbName = "v" & Format(Date, "yyyy-mm-dd")
    End If

    .SaveAs wbName & wbExt
End With

End Sub

it relies on "IsDate" VBA function. hoping users haven't had too much fantasy as to how type in a date...

user3598756
  • 28,893
  • 4
  • 18
  • 28
  • I'm sorry for a delay, but I've tried your method and it wont work until a wbName will be a fully date. I mean that, for example wbName "bicycle 2015-02-02.xlsm" won't be recognised as a date. But I need it to be recognised, because from that string i need to cut a date, and to the string without it - add today's date. This is what i mean: from "bicycle 2015-02-02.xlsm" > "bicycle 2016-04-13.xlsm" and from "bicycle.xlsm" > "bicycle 2016-04-13.xlsm" – Damian Apr 13 '16 at 07:00
  • see edited post. if my answer fulfill your question, please mark it as accepted. if it proves useful you may want to up-vote it. thanks – user3598756 Apr 13 '16 at 12:56
  • I need to wait until my reputation will be on 15 lvl. For now i cannot up-vote it. – Damian Apr 19 '16 at 00:25
  • I see. But did my answer fullfill your question? – user3598756 Apr 19 '16 at 04:36