CODEWITHSUNDEEP
vbavbscript
Pramod Karandikar
Pramod Karandikar

Reputation: 5329

Converting VBA Format$ to VBS

I am working on a simple VBA to show tomorrow's meetings from my Outlook calendar. The idea is to schedule this VBA every evening to show the next day's appointments in case I have missed checking them before leaving the office.

To test the code, I wrote it as an MS Excel macro. Here's the full code:

Sub getMyAppointmentsForTomorrow()
    Dim objOutlook
    Dim objNameSpace
    Dim objFolder
    Dim MyItems
    Dim CurrentAppointment
    Dim meetingDetails
    Dim dateTomorrowWihoutTime

    Dim restrictionString

    Const olFolderCalender = 9

    Set objOutlook = CreateObject("Outlook.application")
    Set objNameSpace = objOutlook.GetNameSpace("MAPI")
    Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalender)
    Set olItems = objFolder.items
    olItems.Sort "[Start]"
    olItems.IncludeRecurrences = True

    myStart = Date
    myEnd = DateAdd("d", 3, myStart)

    StartDate = Format$(Date, "mmm-dd-yyyy")
    EndDate = Format$(DateAdd("d", 1, StartDate), "mmm-dd-yyyy")

    strRestriction = "[Start] >= '" & _
    Format$(myStart, "mmm-dd-yyyy") _
    & "' AND [End] <= '" & _
    Format$(myEnd, "mmm-dd-yyyy") & "'"
    Set oItemsInDateRange = olItems.Restrict(strRestriction)

    dateTomorrow = Format$(DateAdd("d", 1, StartDate), "mmm-dd-yyyy")
    dayAfterTomorrow = Format$(DateAdd("d", 2, StartDate), "mmm-dd-yyyy")

    For Each CurrentAppointment In oItemsInDateRange
        If CurrentAppointment.Start >= DateValue(dateTomorrow) And CurrentAppointment.Start <= DateValue(dayAfterTomorrow) Then
            meetingDetails = meetingDetails & CurrentAppointment.Subject & " " & CurrentAppointment.Start & vbNewLine
        End If
    Next
    MsgBox ("*** Tomorrow's Meetings ***" & vbNewLine & vbNewLine & meetingDetails)

End Sub

I need to run it as a standalone file. I tried to save this file as .vbs and run it, but it shows error Invalid Character at Format$. I also tried to embed the script in an HTA file but the same error is encountered.

Is there a way to run this code in a standalone file?

Upvotes: 0

Views: 511

Answers (2)

MikeC
MikeC

Reputation: 958

' StartDate, EndDate, myStart, myEnd variables not needed; so, I removed them
' dateTomorrowWihoutTime variable is not being used; removed it
' dateTomorrow, dayAfterTomorrow are being used as Date Values; so, removed conversion to (and back from) string
' restrictionString is not being used; renamed to strRestriction which is being used.
' "Option Explicit" is needed at the top of the module (both VBA and VBScript) to enforce variable declaration; added it.
' Added some declarations needed
' Initiallized meetingDetails variable outside the For loop; just a matter of practice, not really needed in this case
' Added strMeetings to show additional meeting information in a slightly different format
' Works in Excel VBA and as VBScript without any changes
' Scope for improvement: Optionally send the message text to the default printer

Option Explicit

Sub getMyAppointmentsForTomorrow()
    Dim olItems
    Dim CurrentAppointment

    Dim dateTomorrow
    Dim dayAfterTomorrow

    Dim meetingDetails
    Dim strRestriction
    Dim strMeetings

    Const olFolderCalender = 9




    dateTomorrow = DateAdd("d", 1, Date)
    dayAfterTomorrow = DateAdd("d", 2, Date)

    Set olItems = CreateObject("Outlook.application").GetNameSpace("MAPI").GetDefaultFolder(olFolderCalender).items
    olItems.Sort "[Start]"
    olItems.IncludeRecurrences = True

    strRestriction = "([Start] >= '" & dateTomorrow & "') AND ([End] < '" & dayAfterTomorrow & "')"

    meetingDetails = ""
    strMeetings = ""
    For Each CurrentAppointment In olItems.Restrict(strRestriction)
        If (CurrentAppointment.Start >= dateTomorrow) And (CurrentAppointment.Start <= dayAfterTomorrow) Then
            meetingDetails = meetingDetails & CurrentAppointment.Subject & " " & CurrentAppointment.Start & vbNewLine
            strMeetings = strMeetings & CurrentAppointment.Start & " - " & CurrentAppointment.Location & vbNewLine & CurrentAppointment.Subject & vbNewLine & vbNewLine
        End If
    Next
    If (Len(strMeetings) > 4) Then ' Eliminate trailing newlines
        strMeetings = Left(strMeetings, Len(strMeetings) - 4)
    End If

    MsgBox ("*** Tomorrow's Meetings ***" & vbNewLine & vbNewLine & meetingDetails)
    MsgBox strMeetings, vbInformation, "Tomorrow's Meetings"
End Sub

getMyAppointmentsForTomorrow

Upvotes: 1

Pramod Karandikar
Pramod Karandikar

Reputation: 5329

The issue was resolved after I changed Format$ to FormatDateTime (As pointed out in comments by MikeC). No other changes were needed.

Upvotes: 0

Related Questions